TOS Silver 2000

home *** CD-ROM | disk | FTP | other *** search

/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / RUNTIME.I < prev next >

Wrap

Text File | 1994-02-08 | 112.3 KB | 3 lines

⓪ IMPLEMENTATION MODULE Runtime;⓪ (*$Y+,J-,L-,R-,N+,C-,X+*)⓪ ⓪ (**********************************************************************⓪ ⓪,Runtime Support fuer Atari Modula-Compiler V#390⓪ ⓪!30.10.86 Version fuer Atari, mit neuem Stringformat:⓪,CAP, STAS angepasst,⓪,RangeCheck fuer CHR.⓪"1.11.86 STAS fuer Stringlaenge > 32K korrigiert;⓪,Prozeduren zur Coroutinen-Unterstuetzung als Dummy.⓪"3.11.86 CHR und CAP fuer neue Char-Darstellung (mit folgendem SyncByte)⓪!30.11.86 Set-Operationen verkraften ungerade Laengenangaben⓪!19.12.86 TrapCode 7 fuer Zugriff ueber NIL-Pointer definiert⓪!22.01.87 TRAP-Auswertung wieder impl.⓪!04.02.87 STAS: BCS ok2 statt BEQ ok2.⓪!27.02.87 TRAP 15: trp0->trp9; GEM-Alert impl.; DivByZero,TRAPV,Addr- und⓪,Bus-Error abgefangen; Vektor-Restauration per SetTerminateProc;⓪,trp7 (access via NIL-Ptr) raus.⓪!02.03.87 Traps:USP wird gerettet; Scan-Aufruf impl.⓪!19.03.87 Fehlerbehandlung -> GEMError-Modul⓪!09.05.87 TRAP-Nummern geändert⓪!19.06.87 neue Real-Arithmetik⓪!30.06.87 IOTransfer impl.⓪!08.07.87 D7->#1; bei Fehler wird Aufrufer angescanned.⓪!22.07.87 IOTransfer, LISTEN, usw. impl.;⓪!23.07.87 @PRIO impl, IOTransfer kann auch auf Vektoren >= $400 ange-⓪,wendet werden.⓪!11.08.87 abermals D7->#1 in Set-Funktionen (wie kam D7 da wieder hin ??)⓪!29.08.87 @IDIV korrigiert (UNLK u. MOVEM vertauscht)⓪!08.09.87 @IOCA neu⓪!27.10.87 FLOAT und TRUNC auf LONGCARD-Parameter umgestellt⓪!13.11.87 @LSTN decr. IR um Eins⓪!16.12.87 Realvergleiche korrigiert (Null galt als größer als Zahlen⓪-mit negativem Exponenten): RELE, REGE, RELT, REGT⓪!17.12.87 Realvergleiche jetzt hoffentlich ok⓪!16.01.88 @PRIO geht auch im Superv.-Mode⓪!01.04.88 @FPDIV für negativen Divisor korrigiert; @IOCA geht jetzt.⓪!09.04.88 Coroutinen-Anpassung f. 68020.⓪!28.05.88 @RES1 und @RES2 für Procedure Entries (ab Comp 3.6a) verwendet⓪!19.07.88 @SMEM, @LRLE, @LRGE, @LRLT, @LRGT zerstören nicht mehr D3/D4.⓪!12.08.88 CAP berücksichtigt auch nicht-deutsche Umlaute.⓪!01.01.88 TRUNC löst Runtime-Error bei neg. Arg. aus⓪!19.01.89 881-Unterstützung von MR (26.8.88) übernommen (Cond: A68881)⓪!15.06.89 Include-File f. Prozessoren⓪!16.06.89 881-Routinen überarbeitet (optimiert, Errors)⓪!04.07.89 @STAS korrigiert - machte bei ungeradem Source-String Mist⓪!19.08.89 Runtime läuft nun gleichzeitg mit 68000 & 68020⓪!30.11.89 Optimierungen in Long-Mul/Div/Mod (LINK verlagert)⓪!05.12.89 neue Long- & Set-Ops mit Reg-Übergabe;⓪!07.01.90 @RES2 nimmt nun D0.L statt D0.W⓪!11.02.90 ShortReals impl.; Automatische Verwenmdung einer in-/externen FPU⓪!18.02.90 MOD/DIV f. LONG/WORD implementiert; FLOAT/TRUNC vervollst.;⓪,LongDiv/Mod: LSL #1 durch ADD ersetzt⓪!15.05.90 Alle Error-Meldungen machen LINK nun auf abgeräumten Stack, damit⓪,scanning korrekt geht; Fehler in @LADD behoben; Die Grundrechen-⓪,arten für Shortreals zerstören nicht mehr das Highword v. D3/D4.⓪!28.05.90 REAL-Routinen verwenden nun FP2 statt FP0⓪!13.06.90 Coroutinen benutzen nicht mehr "EnterSupervisorMode"⓪!17.06.90 Shortreals: 0.64 * 200. geht jetzt⓪!17.07.90 @LTOS: Null-Erkennung korrigiert (sollte Exp-Word testen, tat es⓪,aber mit Bits 32-47)⓪!20.07.90 @SEQL: Nun wordweise⓪!23.07.90 @LDIV: Bei 0./0. wird nun Div by zero gemeldet⓪!12.09.90 Bei einigen der Real-Routinen fehlte die A68881-Condition⓪!10.10.90 CaughtExceptions werden f. TT-FPU erweitert; ST-FPU-Routinen⓪,sind mit Conditionals auch bei TT-FPU verwendbar, allerdings nur,⓪,wenn der Cache abgeschaltet ist!⓪!15.10.90 Fehler in 'hdlCall' (IOTRANSFER) behoben: Wenn Aufruf bei Soft-⓪,Vektoren aus Usermode kam, wurden Regs zerstört -> Absturz;⓪,Bei TT-FPU-Code wird Fehler gemeldet, wenn FPU nicht vorhanden⓪!05.11.90 Nochn Fehler in 'hdlCall' behoben: Bei Call aus User-Mode wurde⓪,A6 statt A0 als dest^ gemerkt.⓪!17.12.90 Alle MOVE from SR-Instr. wg. 68020 entfernt⓪!20.02.91 Warteschleifen bei ST-FPU hinzugefügt, damit's auch mit dem⓪,hyperCACHE 030 läuft.⓪!02.03.91 @RES1 f. Vergleich von lok. Proc-Vars⓪!27.03.91 Korrekturen bei ST-FPU - nix ging mehr.⓪!09.04.91 @ROTA/@SHFT implementiert, aber erstmal nur für vollständige⓪,Bytes/Words/Longs.⓪!18.04.91 Wenn M68881, dann werden auch schnellere 68020-Mul/Div-Instrs verw.;⓪,@IMLW setzt nun Overflow- statt Carry-Bit, @IMLL erkennt Überläufe,⓪,@IMLW geht auch korrekt mit neg. Long-Operand (in D0), @IDVW/@CDVW/⓪,@IMDW/@CMDW korrigiert und getestet.⓪!11.08.91 MOVE from SR-Instr. in NEWPROCESS durch MOVE #$2300 ersetzt.⓪!14.02.92 GEMDOS.Super-Aufrufe statt Supexec wg. MinT.⓪!07.07.92 MOVE #$2300 in NEWPROCESS durch #$0300 ersetzt.⓪!08.02.94 Kein Byte-Zugriff mehr auf fpstat+1 wg. STE. Dabei auch die Warte-⓪,schleifen bei @Fxxx geändert: Offenbar ist es nicht nötig, _vor_⓪,dem Setzen des cmds zu warten, sondern erst danach -> bessere⓪,Performance.⓪ ***********************************************************************)⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, WORD;⓪ ⓪ FROM MOSConfig IMPORT CoroutineTrapNo, CaughtExceptions;⓪ ⓪ FROM MOSSupport IMPORT ToSuper, ToUser;⓪ ⓪ FROM SysTypes IMPORT⓪"ExcSet, BSUnExc, FPZeroDivide, OpError, FPOverflow, NANExc;⓪ ⓪ FROM SystemError IMPORT Abort;⓪ ⓪ IMPORT MOSGlobals, SysInfo, Block;⓪ ⓪ FROM SFP004 IMPORT FPUError, FPUReset, FPUInit;⓪ ⓪ FROM ResCtrl IMPORT CatchRemoval, RemovalCarrier;⓪ ⓪ ⓪ ⓪ CONST DftSF = $0010;⓪(rtsCode = $4E75;⓪ ⓪ (*$I FPU.CNF *)⓪ ⓪ CONST Code20 = M68881;⓪(IEEEReal = M68881 OR A68881;⓪(SoftReal = NOT IEEEReal;⓪(AutoFPU = FALSE;⓪ ⓪ VAR useSF: BOOLEAN;⓪ ⓪ (*$? AutoFPU:⓪(fpu: INTEGER; (* -1: soft, 0: external, 1: internal *)⓪ *)⓪ ⓪ (*$? M68881:⓪((*⓪)* Puffer für generische FPU-Cmds (f. interne FPU mit $F+)⓪)* Vorsicht: Reihenfolge nicht vertauschen!⓪)*)⓪(cpGEN0: CARDINAL; (* $F200: cpGEN *)⓪(cpGEN1: CARDINAL; (* F-Instr (Word) *)⓪(cpGEN2: CARDINAL; (* RTS *)⓪(⓪(cpScc0: CARDINAL; (* $F240: cpScc D0 *)⓪(cpScc1: CARDINAL; (* Condition Code *)⓪(cpScc2: CARDINAL; (* RTS *)⓪ ⓪(cpGENL0: CARDINAL; (* $F210: cpGEN (A0) *)⓪(cpGENL1: CARDINAL; (* F-Instr (Word) *)⓪(cpGENL2: CARDINAL; (* RTS *)⓪ ⓪(cpGENS0: CARDINAL; (* $F201: cpGEN D1 *)⓪(cpGENS1: CARDINAL; (* F-Instr (Word) *)⓪(cpGENS2: CARDINAL; (* RTS *)⓪ ⓪(cpPsh70: CARDINAL; (* $F227: cpGEN 4(A7)*)⓪(cpPsh71: CARDINAL; (* F-Instr (Word) *)⓪(cpPsh72: CARDINAL; (* 4 (offset) *)⓪(cpPsh73: CARDINAL; (* RTS *)⓪ ⓪(cpPsh30: CARDINAL; (* $F21B: cpGEN (A3)+*)⓪(cpPsh31: CARDINAL; (* F-Instr (Word) *)⓪(cpPsh32: CARDINAL; (* RTS *)⓪ *)⓪ ⓪ (*$? A68881:⓪ CONST⓪(fpstat = $fffa40; (* Response word of MC68881 read *)⓪(fpctrl = $fffa42; (* Control word of MC68881 write *)⓪(fpcmd = $fffa4a; (* Command word of MC68881 write *)⓪(fpcond = $fffa4e; (* Condition word of MC68881 write *)⓪(fpop = $fffa50; (* Operand long of MC68881 read/write *)⓪(fpregsel= $fffa54; (* register select long read *)⓪(⓪(A2stat = 0; (* Response word of MC68881 read *)⓪(A2ctrl = 2; (* Control word of MC68881 write *)⓪(A2cmd = 10; (* Command word of MC68881 write *)⓪(A2cond = 14; (* Condition word of MC68881 write *)⓪(A2op = 16; (* Operand long of MC68881 read/write *)⓪(A2regsel= $14; (* register select long read *)⓪ *)⓪ ⓪ (************** Coroutinen-Unterstuetzung **************)⓪ ⓪ ⓪ VAR superTrapV: ADDRESS;⓪ ⓪ (*⓪!* PROCEDURE super ();⓪!*⓪!* Geht in den Supervisor-Modus; der SSP wird dabei zum A7;⓪!* A0 wird verändert; D0 liefert altes SR⓪!*)⓪ VAR super: ARRAY [0..2] OF WORD; (* hierin steht die richtige Super-Routine *)⓪ ⓪ PROCEDURE superCopy;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L (A7)+,A0⓪(TRAP #0 ; dieser Wert wird gepatched!⓪(JMP (A0)⓪$END⓪"END superCopy;⓪ ⓪ PROCEDURE HdlSuper;⓪"BEGIN⓪$ASSEMBLER⓪(ASC 'XBRA' ; XBRA-Kennung⓪(ASC 'MM2C' ; eigene Kennung⓪(DC.L 0 ; old vector⓪(MOVE (A7),D0 ; altes SR nach D0⓪(BSET #5,(A7)⓪(RTE⓪$END⓪"END HdlSuper;⓪ ⓪ PROCEDURE LinkOut;⓪"BEGIN⓪$ASSEMBLER⓪(TST.L superTrapV⓪(BEQ rtn ; nicht installiert⓪(SUBQ.L #4,A7⓪(JSR ToSuper⓪(⓪(LEA HdlSuper,A2⓪(ADDA.W #12,A2⓪(MOVE.L superTrapV,A0⓪%l: MOVE.L (A0),A1⓪(CMPA.L A2,A1 ; 'entry' gefunden?⓪(BEQ f⓪(CMPI.L #$58425241,-12(A1) ; Ist dies ein XBRA-Eintrag?⓪(BNE n ; Nein -> entry hier trotzdem austragen⓪(LEA -4(A1),A0 ; Vorige Vektoradr. nach A0⓪(BRA l⓪%n: MOVE.L A2,A1⓪%f: MOVE.L -4(A1),(A0) ; Entry.old eintragen⓪(CLR.L superTrapV⓪(⓪(JSR ToUser⓪(ADDQ.L #4,A7⓪%rtn:⓪$END⓪"END LinkOut;⓪ ⓪ PROCEDURE LinkIn;⓪"BEGIN⓪$ASSEMBLER⓪(TST.L superTrapV⓪(BNE rtn ; bereits installiert⓪(⓪(SUBQ.L #4,A7⓪(JSR ToSuper⓪(⓪(MOVE.W CoroutineTrapNo,D0⓪(MOVE D0,D1⓪(LSL.W #2,D0 ; mal 4⓪(ADDI.W #$80,D0 ; plus TRAP #0⓪(MOVE.W D0,A0⓪(MOVE.L A0,superTrapV⓪(; 'super'-Routine mit richtigem TRAP-Befehl im BSS erzeugen⓪(LEA superCopy,A1⓪(LEA super,A2⓪(MOVE.W (A1)+,(A2)+ ; MOVE.L (A7)+,A0⓪(MOVE.W (A1)+,D0⓪(OR.W D1,D0⓪(MOVE.W D0,(A2)+ ; TRAP #<D1>⓪(MOVE.W (A1)+,(A2)+ ; JMP (A0)⓪(LEA HdlSuper,A1⓪(ADDA.W #12,A1⓪(MOVE.L (A0),-4(A1) ; alten Vektor retten (in XBRA-Struktur)⓪(MOVE.L A1,(A0)⓪$⓪(JSR ToUser⓪(ADDQ.L #4,A7⓪%rtn:⓪$END⓪"END LinkIn;⓪ ⓪ ⓪ PROCEDURE BadReturn; (* RTS aus CoRoutine anmeckern *)⓪"BEGIN⓪$ASSEMBLER⓪(TRAP #6⓪(DC.W -15-$6000 ; kein cont, scan prev⓪$END⓪"END BadReturn;⓪ ⓪ (*⓪#Transferdaten beim Usermode:⓪(2 Byte - 0: zeigt Usermode an / 1: Vektor zus. restaurieren⓪(4 Byte - PC⓪(2 Byte - SR⓪(4 Byte - A6⓪(56 Byte - D0-A5⓪&{ 60 Byte - FP3-FP7 } (* wenn SwitchFPUContext = TRUE *)⓪ ⓪#Transferdaten beim Supervisormode:⓪(2 Byte - $FFxx, zeigt Supervisormode an⓪(4 Byte - USP⓪(60 Byte - D0-A6⓪(4 Byte - Dummy⓪(2 Byte - SR⓪(4 Byte - PC⓪&{ 60 Byte - FP3-FP7 } (* wenn SwitchFPUContext = TRUE *)⓪ *)⓪ ⓪ (* Kennung: Zustand:⓪$0 Normal u. Exc-Rückkehr - Usermode⓪$1 Warten auf Exc - Usermode, Vektor restaurieren⓪$$FF Exc-Rückkehr - Supervisormode⓪ *)⓪ ⓪ PROCEDURE @NEWP ( p:PROC; a:ADDRESS; n:LONGCARD; VAR prc:ADDRESS );⓪"BEGIN⓪$ASSEMBLER⓪(LINK A5,#0⓪(⓪(MOVE.L -(A3),A1 ; 'prc'⓪(MOVE.L -(A3),A0 ; SIZE (workspace)⓪(MOVE.L A0,D1⓪(BCLR #0,D1⓪(MOVE.L -(A3),D0 ; ADR (workspace)⓪(ADDQ.L #1,D0⓪(BCLR #0,D0⓪(ADDA.L D0,A0 ; ENDADR (workspace)⓪(MOVE.L -(A3),D2 ; ADR (procedure)⓪(CMPI.L #90,D1 ; ist workspace groß genug ?⓪(BCC wspOk⓪(⓪(TRAP #6⓪(DC.W -10-$4000 ; 'out of stack'⓪(UNLK A5⓪(RTS⓪(⓪&wspOk:⓪(MOVEM.L A3/A5,-(A7)⓪(⓪(MOVE.L D0,A3⓪(⓪(MOVE.L D2,-(A0) ;Adresse für scan⓪(ADDQ.L #2,(A0) ;scan-Adr etwas vorsetzen⓪(CLR.L -(A0) ;voriges A5⓪(MOVE.L A0,A5 ;für UNLK in backScan()⓪(MOVE.L #BadReturn,-(A0) ;Fehlerbehandlung bei RTS aus Coroutine⓪(⓪(MOVEM.L D0-A5,-(A0) ; Bis auf A3,A5 nur Dummy-Werte⓪(MOVE.L A6,-(A0)⓪(MOVE.W #$0300,-(A0) ; Default-SR⓪(MOVE.L D2,-(A0)⓪(CLR.W -(A0)⓪(⓪(; nun den SP in 'prc' ablegen⓪(MOVE.L A0,(A1)⓪(⓪(JSR LinkIn ; Supervisor-TRAP installieren⓪(⓪(MOVEM.L (A7)+,A3/A5⓪(UNLK A5⓪$END⓪"END @NEWP;⓪ ⓪ ⓪ ⓪ PROCEDURE @TRAN ( VAR source,dest:ADDRESS ); (* Transfer *)⓪"BEGIN⓪$ASSEMBLER⓪(; Aufruf erfolgt immer im Usermode, der zu startende Prozeß⓪(; kann in beiden Modi ablaufen⓪(⓪(MOVE.L -(A3),A2 ; dest⓪(MOVE.L -(A3),A1 ; source⓪(⓪(JSR super⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; aktiven Prozeß beenden⓪(MOVE.L USP,A0⓪(MOVE.L (A0)+,D1 ; Rücksprungadr. hinter TRANSFER⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D0,-(A0) ; altes SR⓪(MOVE.L D1,-(A0)⓪(CLR.W -(A0)⓪(⓪(MOVE.L (A2),D0 ; zuerst retten, falls A1=A2⓪(MOVE.L A0,(A1)⓪(MOVE.L D0,A6⓪(⓪(; neuen Prozeß starten⓪(TST.W (A6)+⓪(BEQ stUsr⓪(BMI stSup⓪(⓪(; starte Usermode, vorher Vektor restaurieren⓪(MOVE.L (A6)+,D0 ; alter Vektor⓪(MOVE.L 4+2+4+4(A6),A0 ; D1: Vektoradr.⓪(MOVE.L D0,(A0)⓪(TST useSF⓪(BEQ no20⓪(MOVE #DftSF,-(A7)⓪ no20:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stUsr: ; starte Usermode⓪(TST useSF⓪(BEQ no20b⓪(MOVE #DftSF,-(A7)⓪ no20b:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stSup: ; starte Supervisormode⓪(MOVE.L A6,A7⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,USP⓪(MOVEM.L (A7)+,D0-A6⓪(ADDQ.L #4,A7⓪(TST useSF⓪(BEQ no20c⓪(MOVE.W (A7),-(A7)⓪(MOVE.L 4(A7),2(A7)⓪(MOVE #DftSF,6(A7)⓪ no20c:⓪(RTE⓪$END⓪"END @TRAN;⓪ ⓪ PROCEDURE hdlExc;⓪"(* Für IOTRANSFER-Auslösungen per Exception *)⓪"BEGIN⓪$ASSEMBLER⓪(; Der Aufruf kann aus beiden Modi kommen, der zu startende⓪(; Prozeß ist immer im Usermode⓪(⓪(BTST.B #5,4(A7) ; aus welchem mode ?⓪(BNE frSup⓪(⓪((*⓪(ADDQ.L #4,A7⓪(JMP $FC429C⓪(*)⓪(⓪(; Entry aus User mode⓪(⓪(; Daten auf den USP retten⓪(MOVE.L A6,-(A7)⓪(MOVE.L USP,A6⓪(MOVEM.L D0-A5,-(A6)⓪(MOVE.L (A7)+,-(A6)⓪(MOVE.L (A7)+,A0 ; ^Transfer-Daten⓪(MOVE (A7)+,-(A6) ; SR⓪(MOVE.L (A7)+,-(A6) ; PC⓪(CLR.W -(A6)⓪(⓪(; A0 zeigt auf:⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A6,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST useSF⓪(BEQ no20d⓪(MOVE #DftSF,-(A7)⓪ no20d:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ frSup: ; Entry aus Supervisor mode⓪(⓪(; Daten auf den SSP retten⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L USP,A6⓪(MOVE.L A6,-(A7)⓪(ST.B -(A7)⓪(⓪(MOVE.L 2+4+60(A7),A0 ; ^Transfer-Daten⓪(⓪(; A0: (s.o.)⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A7,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST useSF⓪(BEQ no20e⓪(MOVE #DftSF,-(A7)⓪ no20e:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪$END⓪"END hdlExc;⓪ ⓪ PROCEDURE hdlCall;⓪"(* Für IOTRANSFER-Auslösungen per JSR *)⓪"BEGIN⓪$ASSEMBLER⓪(; Der Aufruf kann aus beiden Modi kommen, der zu startende⓪(; Prozeß ist immer im Usermode⓪(⓪(MOVEM.L D0/A0,-(A7)⓪(JSR super⓪(BTST #13,D0 ; aus welchem Mode ?⓪(BNE frSup⓪(⓪(; Entry aus User mode⓪(⓪(; Aktiven Prozeß beenden, Daten auf den USP retten⓪(; auf USP stehen noch: D0/A0, ^Dest-Transfer-Daten, PC.L⓪(MOVE.L USP,A0⓪(MOVE.L (A0)+,-(A7) ; D0 retten⓪(MOVE.L (A0)+,-(A7) ; A0 retten⓪(MOVE.L (A0)+,-(A7) ; ^Transfer-Daten⓪(MOVE.L (A0)+,-(A7) ; PC retten⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D0,-(A0) ; SR⓪(MOVE.L (A7)+,-(A0) ; PC⓪(MOVE.L (A7)+,A1 ; ^neue Transfer-Daten⓪(MOVE.L (A7)+,42(A0) ; A0 in Transfer-Daten ablegen⓪(MOVE.L (A7)+,10(A0) ; D0 in Transfer-Daten ablegen⓪(CLR.W -(A0)⓪(⓪(; A1 zeigt auf:⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A1),A2 ; A2: alter dest^⓪(MOVE.L A0,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A1),A3 ; D1: Vektoradr.⓪(LEA 2(A1),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST useSF⓪(BEQ no20f⓪(MOVE #DftSF,-(A7)⓪ no20f:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ frSup: ; Entry aus Supervisor mode⓪(⓪(MOVEM.L (A7)+,D0/A0⓪(SUBQ.L #2,A7⓪(MOVE.L 2(A7),(A7) ; ^Transfer-Daten 2 Byte tiefer⓪(MOVE SR,4(A7) ; SR darüber⓪(⓪(; aktiven Prozeß beenden, Daten auf den SSP retten⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L USP,A0⓪(MOVE.L A0,-(A7)⓪(ST.B -(A7)⓪(⓪(MOVE.L 2+4+60(A7),A0 ; ^Transfer-Daten⓪(⓪(; A0: (s.o.)⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A7,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST useSF⓪(BEQ no20g⓪(MOVE #DftSF,-(A7)⓪ no20g:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪$END⓪"END hdlCall;⓪ ⓪ ⓪ PROCEDURE @IOTR ( VAR source,dest:ADDRESS; vecAddr:ADDRESS );⓪"CONST JSRInstr = $4EB9;⓪"BEGIN⓪$ASSEMBLER⓪(; Aufruf erfolgt immer im Usermode, der zu startende Prozeß⓪(; kann in beiden Modi ablaufen⓪(⓪(MOVE.L -(A3),D1 ; vector⓪(MOVE.L -(A3),A2 ; dest⓪(MOVE.L -(A3),A1 ; source⓪(⓪(JSR super⓪(⓪(; Daten für 'hdlExc' und 'hdlCall':⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; aktiven Prozeß beenden⓪(MOVE.L USP,A0⓪(MOVE.L (A0)+,D2 ; Rücksprungadr. hinter IOTRANSFER⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D0,-(A0) ; altes SR⓪(MOVE.L D2,-(A0) ; PC⓪(⓪(MOVE.L D1,A3⓪(MOVE.L (A3),-(A0) ; alten vektor retten⓪(⓪(MOVE #1,-(A0)⓪(⓪(MOVE.L (A2),A6 ; zuerst retten, falls A1=A2⓪(MOVE.L A0,(A1)⓪(⓪(CMPA.W #$400,A3⓪(BCS isExc⓪(MOVE.L #hdlCall,-(A0)⓪(BRA cont0⓪ isExc MOVE.L #hdlExc,-(A0)⓪ cont0 MOVE #JSRInstr,-(A0)⓪(⓪(MOVE.L A0,(A3) ; neuen vektor auf 'JSR hdlExc/hdlCall'⓪(⓪(; neuen Prozeß starten⓪(TST.W (A6)+⓪(BEQ stUsr⓪(BMI stSup⓪(⓪(; starte Usermode, vorher Vektor restaurieren⓪(MOVE.L (A6)+,D0 ; alter Vektor⓪(MOVE.L 4+2+4+4(A6),A0 ; D1: Vektoradr.⓪(MOVE.L D0,(A0)⓪ stUsr: ; starte Usermode⓪(TST useSF⓪(BEQ no20h⓪(MOVE #DftSF,-(A7)⓪ no20h:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stSup: ; starte Supervisormode⓪(MOVE.L A6,A7⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,USP⓪(MOVEM.L (A7)+,D0-A6⓪(ADDQ.L #4,A7 ; Transfer-Ptr überspringen⓪(TST useSF⓪(BEQ no20j⓪(MOVE.W (A7),-(A7)⓪(MOVE.L 4(A7),2(A7)⓪(MOVE #DftSF,6(A7)⓪ no20j:⓪(RTE⓪$END⓪"END @IOTR;⓪ ⓪ (*⓪ PROCEDURE @TRAN ( VAR source,dest:ADDRESS ); (* Transfer *)⓪"BEGIN⓪$ASSEMBLER⓪(; Aufruf erfolgt immer im Usermode, der zu startende Prozeß⓪(; kann in beiden Modi ablaufen⓪(⓪(JSR super⓪(MOVE.L USP,A0⓪(MOVE D0,D2⓪(⓪(MOVE.L -(A3),A2 ; dest⓪(MOVE.L -(A3),A1 ; source⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; aktiven Prozeß beenden⓪(MOVE.L (A0)+,D0 ; Rücksprungadr. hinter TRANSFER⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D2,-(A0)⓪(MOVE.L D0,-(A0)⓪(CLR.W -(A0)⓪(⓪(MOVE.L (A2),D0 ; zuerst retten, falls A1=A2⓪(MOVE.L A0,(A1)⓪(MOVE.L D0,A6⓪(⓪(; neuen Prozeß starten⓪(TST.W (A6)+⓪(BEQ stUsr⓪(BMI stSup⓪(⓪(; starte Usermode, vorher Vektor restaurieren⓪(MOVE.L (A6)+,D0 ; alter Vektor⓪(MOVE.L 4+2+4+4(A6),A0 ; D1: Vektoradr.⓪(MOVE.L D0,(A0)⓪(TST useSF⓪(BEQ no20⓪(MOVE #DftSF,-(A7)⓪ no20:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stUsr: ; starte Usermode⓪(TST useSF⓪(BEQ no20b⓪(MOVE #DftSF,-(A7)⓪ no20b:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stSup: ; starte Supervisormode⓪(MOVE.L A6,A7⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,USP⓪(MOVEM.L (A7)+,D0-A6⓪(ADDQ.L #4,A7⓪(TST useSF⓪(BEQ no20c⓪(MOVE.W (A7),-(A7)⓪(MOVE.L 4(A7),2(A7)⓪(MOVE #DftSF,6(A7)⓪ no20c:⓪(RTE⓪$END⓪"END @TRAN;⓪ ⓪ PROCEDURE hdlExc;⓪"(* Für IOTRANSFER-Auslösungen per Exception *)⓪"BEGIN⓪$ASSEMBLER⓪(; Der Aufruf kann aus beiden Modi kommen, der zu startende⓪(; Prozeß ist immer im Usermode⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(BTST.B #5,4(A7) ; aus welchem mode ?⓪(BNE frSup⓪(⓪(; Entry aus User mode⓪(⓪(; Daten auf den USP retten⓪(MOVE.L A6,-(A7)⓪(MOVE.L USP,A6⓪(MOVEM.L D0-A5,-(A6)⓪(MOVE.L (A7)+,-(A6)⓪(MOVE.L (A7)+,A0 ; ^Transfer-Daten⓪(MOVE (A7)+,-(A6) ; SR⓪(MOVE.L (A7)+,-(A6) ; PC⓪(CLR.W -(A6)⓪(⓪(; A0 zeigt auf:⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A6,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST useSF⓪(BEQ no20d⓪(MOVE #DftSF,-(A7)⓪ no20d:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ frSup: ; Entry aus Supervisor mode⓪(⓪(; Daten auf den USP retten⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L USP,A6⓪(MOVE.L A6,-(A7)⓪(ST.B -(A7)⓪(⓪(MOVE.L 2+4+60(A7),A0 ; ^Transfer-Daten⓪(⓪(; A0: (s.o.)⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A7,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST useSF⓪(BEQ no20e⓪(MOVE #DftSF,-(A7)⓪ no20e:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪$END⓪"END hdlExc;⓪ ⓪ ⓪ PROCEDURE hdlCall;⓪"(* Für IOTRANSFER-Auslösungen per JSR *)⓪"BEGIN⓪$ASSEMBLER⓪(; Der Aufruf kann aus beiden Modi kommen, der zu startende⓪(; Prozeß ist immer im Usermode⓪(⓪(MOVE.L D1,-(A7)⓪(⓪(MOVEM.L D0/D2/A0-A2,-(A7)⓪(MOVEQ #1,D0⓪(MOVE.L D0,-(A7)⓪(MOVE #$20,-(A7)⓪(TRAP #1⓪(TST.W D0⓪(BNE frSup⓪(⓪(; Entry aus User mode⓪(⓪(MOVE.W D0,4(A7)⓪(TRAP #1⓪(ADDQ.L #6,A7⓪(MOVE.L D0,D1⓪(MOVEM.L (A7)+,D0/D2/A0-A2⓪(MOVE.L A7,USP⓪(MOVE.L D1,A7 ; SSP wiederherstellen⓪(⓪(MOVE SR,D1⓪(ANDI #$CFFF,D1⓪(⓪(;BREAK⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; Aktiven Prozeß beenden, Daten auf den USP retten⓪(; auf USP stehen noch: D1.L, ^Dest-Transfer-Daten, PC.L⓪(MOVE.L A0,-(A7)⓪(MOVE.L USP,A0⓪(MOVE.L (A0)+,-(A7) ; D1 retten⓪(MOVE.L (A0)+,-(A7) ; ^Transfer-Daten⓪(MOVE.L (A0)+,-(A7) ; PC retten⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D1,-(A0) ; SR⓪(MOVE.L (A7)+,-(A0) ; PC⓪(MOVE.L (A7)+,14(A0) ; D1 in Transfer-Daten ablegen⓪(MOVE.L (A7)+,A1 ; ^Transfer-Daten⓪(MOVE.L (A7)+,42(A0) ; A0 in Transfer-Daten ablegen⓪(CLR.W -(A0)⓪(⓪(; A1 zeigt auf:⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A1),A2 ; A2: alter dest^⓪(MOVE.L A0,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A1),A3 ; D1: Vektoradr.⓪(LEA 2(A1),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST useSF⓪(BEQ no20f⓪(MOVE #DftSF,-(A7)⓪ no20f:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ frSup: ; Entry aus Supervisor mode⓪(⓪(ADDQ.L #6,A7⓪(MOVEM.L (A7)+,D0/D2/A0-A2⓪(⓪(MOVE.L (A7),D1⓪(ADDQ.L #2,A7⓪(MOVE.L 2(A7),(A7) ; ^Transfer-Daten 2 Byte tiefer⓪(MOVE SR,4(A7) ; SR darüber⓪(⓪(;BREAK⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; aktiven Prozeß beenden, Daten auf den USP retten⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L USP,A0⓪(MOVE.L A0,-(A7)⓪(ST.B -(A7)⓪(⓪(MOVE.L 2+4+60(A7),A0 ; ^Transfer-Daten⓪(⓪(; A0: (s.o.)⓪(⓪(MOVE.L 2+4+4+2+4+32+8(A0),A2 ; A2: alter dest^⓪(MOVE.L A7,(A2)⓪(⓪(MOVE.L 2+4+4+2+4+4(A0),A3 ; D1: Vektoradr.⓪(LEA 2(A0),A6⓪(MOVE.L (A6)+,(A3) ; alten Vektor restaurieren⓪(TST useSF⓪(BEQ no20g⓪(MOVE #DftSF,-(A7)⓪ no20g:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪$END⓪"END hdlCall;⓪ ⓪ ⓪ PROCEDURE @IOTR ( VAR source,dest:ADDRESS; vecAddr:ADDRESS );⓪"CONST JSRInstr = $4EB9;⓪"BEGIN⓪$ASSEMBLER⓪(; Aufruf erfolgt immer im Usermode, der zu startende Prozeß⓪(; kann in beiden Modi ablaufen⓪(⓪(JSR super⓪(MOVE.L USP,A0⓪(MOVE D0,D2⓪(⓪(MOVE.L -(A3),D1 ; vector⓪(MOVE.L -(A3),A2 ; dest⓪(MOVE.L -(A3),A1 ; source⓪(⓪(MOVE #$2700,SR ; keine Interrupts !⓪(⓪(; Daten für 'hdlExc' und 'hdlCall':⓪(; 2 Byte - 1, zeigt IOTR an⓪(; 4 Byte - alter Exc-Vektor⓪(; 4 Byte - PC⓪(; 2 Byte - SR⓪(; 4 Byte - A6⓪(; 56 Byte - D0-A5⓪(⓪(; ③aktiven Prozeß beenden④⓪(MOVE.L (A0)+,D0 ; Rücksprungadr. hinter IOTRANSFER⓪(MOVEM.L D0-A5,-(A0)⓪(MOVE.L A6,-(A0)⓪(MOVE.W D2,-(A0)⓪(MOVE.L D0,-(A0)⓪(⓪(MOVE.L D1,A3⓪(MOVE.L (A3),-(A0) ; alten vektor retten⓪(⓪(MOVE #1,-(A0)⓪(⓪(MOVE.L (A2),D0 ; zuerst retten, falls A1=A2⓪(MOVE.L A0,(A1)⓪(MOVE.L D0,A6⓪(⓪(CMPA.W #$400,A3⓪(BCS isExc⓪(MOVE.L #hdlCall,-(A0)⓪(BRA cont0⓪ isExc MOVE.L #hdlExc,-(A0)⓪ cont0 MOVE #JSRInstr,-(A0)⓪(⓪(MOVE.L A0,(A3) ; neuen vektor auf 'JSR hdlExc/hdlCall'⓪(⓪(; ③neuen Prozeß starten④⓪(TST.W (A6)+⓪(BEQ stUsr⓪(BMI stSup⓪(⓪(; starte Usermode, vorher Vektor restaurieren⓪(MOVE.L (A6)+,D0 ; alter Vektor⓪(MOVE.L 4+2+4+4(A6),A0 ; D1: Vektoradr.⓪(MOVE.L D0,(A0)⓪(TST useSF⓪(BEQ no20h⓪(MOVE #DftSF,-(A7)⓪ no20h:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stUsr: ; starte Usermode⓪(TST useSF⓪(BEQ no20i⓪(MOVE #DftSF,-(A7)⓪ no20i:⓪(MOVE.L (A6)+,-(A7) ; PC⓪(MOVE.W (A6)+,-(A7) ; SR⓪(MOVE.L (A6)+,-(A7) ; A6⓪(MOVEM.L (A6)+,D0-A5⓪(MOVE.L A6,USP⓪(MOVE.L (A7)+,A6⓪(RTE⓪(⓪ stSup: ; starte Supervisormode⓪(MOVE.L A6,A7⓪(MOVE.L (A7)+,A0⓪(MOVE.L A0,USP⓪(MOVEM.L (A7)+,D0-A6⓪(ADDQ.L #4,A7⓪(TST useSF⓪(BEQ no20j⓪(MOVE.W (A7),-(A7)⓪(MOVE.L 4(A7),2(A7)⓪(MOVE #DftSF,6(A7)⓪ no20j:⓪(RTE⓪$END⓪"END @IOTR;⓪ *)⓪ ⓪ PROCEDURE @LSTN;⓪"BEGIN⓪$ASSEMBLER⓪(CLR.L -(A7)⓪(MOVE #$20,-(A7)⓪(TRAP #1⓪(MOVE.L D0,2(A7)⓪(MOVE SR,D1⓪(MOVE D1,D0⓪(ANDI #$0700,D0⓪(BEQ ok⓪(MOVE D1,D0⓪(SUBI #$0100,D0⓪(MOVE D0,SR⓪(NOP⓪(NOP⓪&ok:⓪(MOVE D1,SR⓪(TRAP #1⓪(ADDQ.L #6,A7⓪$END⓪"END @LSTN;⓪ ⓪ PROCEDURE @IOCA ( vecAddr:ADDRESS );⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L (A7)+,A2 ; PC vom USP⓪(JSR super⓪(CMPI.L #$400,-(A3)⓪(BCS isExc⓪(MOVE.L A2,-(A7) ; PC und SR auf den SSP⓪(MOVE D0,-(A7)⓪(MOVEM.L D3-D7/A3-A6,-(A7)⓪(MOVE.L (A3),A1⓪(MOVE.L (A1),A1⓪(JSR (A1) ; Benutzt den SSP als SP⓪(MOVEM.L (A7)+,D3-D7/A3-A6⓪(RTE⓪&isExc:⓪(MOVE.L (A3),A1⓪(MOVE.L (A1),A1⓪(TST useSF⓪(BEQ no20k⓪(MOVE #DftSF,-(A7)⓪ no20k: MOVE.L A2,-(A7) ; PC und SR auf den SSP⓪(MOVE D0,-(A7) ; Routine verwendet SSP als SP⓪(JMP (A1) ; rettet sicherlich alle Register⓪$END⓪"END @IOCA;⓪ ⓪ PROCEDURE @PRIO; (* Set Interrupt Priority *)⓪"BEGIN⓪$(* IR-level in D1, auf Bitpos. wie SR; D0, D2 nicht verändern ! *);⓪$ASSEMBLER⓪(MOVE.L D2,-(A7)⓪(MOVE.L D0,-(A7)⓪(⓪(MOVE.W D1,-(A7)⓪(⓪(MOVEQ #1,D0⓪(MOVE.L D0,-(A7)⓪(MOVE #$20,-(A7)⓪(TRAP #1⓪(TST D0⓪(BNE alreadySuper⓪(⓪(MOVE.W D0,4(A7)⓪(TRAP #1⓪(ADDQ.L #6,A7⓪(MOVE.W (A7)+,D1⓪(⓪(MOVE.L A7,USP⓪(MOVE.L D0,A7 ; SSP wiederherstellen⓪(⓪(MOVE SR,D0⓪(ANDI #$C0FF,D0⓪(ANDI #$0F00,D1⓪(OR D1,D0⓪(MOVE D0,SR⓪(MOVE.L (A7)+,D0⓪(MOVE.L (A7)+,D2⓪(RTS⓪(⓪&alreadySuper⓪(ADDQ.L #6,A7⓪(MOVE.W (A7)+,D1⓪(MOVE SR,D0⓪(ANDI #$F0FF,D0⓪(ANDI #$0F00,D1⓪(OR D1,D0⓪(MOVE D0,SR⓪(MOVE.L (A7)+,D0⓪(MOVE.L (A7)+,D2⓪$END⓪"END @PRIO;⓪ ⓪ (********************** Ende der Coroutinen ***********************)⓪ ⓪ ⓪ PROCEDURE @STK1; (* Stack-Check mit festem $200-Space *)⓪"BEGIN⓪$ASSEMBLER⓪(LEA $200(A3),A0⓪(CMPA.L A7,A0⓪(BCC stackerror⓪(RTS⓪&stackerror⓪(TRAP #6⓪(DC.W $BFF6 ; Stack overflow, caller caused⓪$END⓪"END @STK1;⓪ ⓪ PROCEDURE @STK2; (* Stack-Check mit variablem Space *)⓪"BEGIN⓪$ASSEMBLER⓪(; A0: Check-Wert⓪(ADDA.L A3,A0⓪(CMPA.L A7,A0⓪(BCC stackerror⓪(RTS⓪&stackerror⓪(TRAP #6⓪(DC.W $BFF6 ; Stack overflow, caller caused⓪$END⓪"END @STK2;⓪ ⓪ ⓪ PROCEDURE @ROTA;⓪"BEGIN⓪$ASSEMBLER⓪(; D0: Argument, D1: Weite, D2: maxBitNr, (A0: minBitNr)⓪(TST.W D1⓪(BMI right⓪(BEQ ende⓪(SUBQ.W #7,D2⓪(BEQ bytel⓪(SUBQ.W #8,D2⓪(BEQ wordl⓪(ROL.L D1,D0⓪(RTS⓪ bytel: ROL.B D1,D0⓪(RTS⓪ wordl: ROL.W D1,D0⓪ ende: RTS⓪ right: NEG.W D1⓪(SUBQ.W #7,D2⓪(BEQ byter⓪(SUBQ.W #8,D2⓪(BEQ wordr⓪(ROR.L D1,D0⓪(RTS⓪ byter: ROR.B D1,D0⓪(RTS⓪ wordr: ROR.W D1,D0⓪$END⓪"END @ROTA;⓪ ⓪ PROCEDURE @SHFT;⓪"BEGIN⓪$ASSEMBLER⓪(; D0: Argument, D1: Weite, D2: maxBitNr, (A0: minBitNr)⓪(TST.W D1⓪(BMI right⓪(BEQ ende⓪(CMP.W D2,D1⓪(BHI null⓪(LSL.L D1,D0⓪(RTS⓪ null: MOVEQ #0,D0⓪ ende: RTS⓪ right: NEG.W D1⓪(CMP.W D2,D1⓪(BHI null⓪(LSR.L D1,D0⓪$END⓪"END @SHFT;⓪ ⓪ ⓪ PROCEDURE @LENW;⓪"BEGIN⓪$ASSEMBLER⓪(; A0: Ptr auf String, D0.W: HIGH (String) / Erg., D1 ist frei⓪(MOVE.L A0,D1⓪ l TST.B (A0)+⓪(DBEQ D0,l⓪(BNE c⓪(SUBQ.L #1,A0⓪ c MOVE.L A0,D0⓪(SUB.L D1,D0⓪$END⓪"END @LENW;⓪ ⓪ PROCEDURE @LENL;⓪"BEGIN⓪$ASSEMBLER⓪(; A0: Ptr auf String, D0.L: HIGH (String) / Erg., D1 ist frei⓪(MOVE.L A0,D1⓪(BRA l⓪ l2 SWAP D0⓪ l TST.B (A0)+⓪(DBEQ D0,l⓪(BEQ d⓪(SWAP D0⓪(DBRA D0,l2⓪(BRA c⓪ d SUBQ.L #1,A0⓪ c MOVE.L A0,D0⓪(SUB.L D1,D0⓪$END⓪"END @LENL;⓪ ⓪ ⓪ (*****************************************************************************)⓪ (*** SET - Operationen ***)⓪ (*****************************************************************************)⓪ ⓪ ⓪ PROCEDURE @EXCL; (* Exclude Element aus Set *)⓪"BEGIN⓪$ASSEMBLER⓪(; A0: Ptr auf Set; D0.W: Element; D1 frei⓪(; Range-Check muß außerhalb gemacht werden!⓪(MOVE.W D0,D1⓪(LSR.W #3,D0⓪(BCLR D1,0(A0,D0.W)⓪$END⓪"END @EXCL;⓪"⓪ PROCEDURE @INCL; (* Include Element in Set *)⓪"BEGIN⓪$ASSEMBLER⓪(; A0: Ptr auf Set; D0.W: Element; D1 frei⓪(; Range-Check muß außerhalb gemacht werden!⓪(MOVE.W D0,D1⓪(LSR.W #3,D0⓪(BSET D1,0(A0,D0.W)⓪&END⓪$END @INCL;⓪ ⓪ PROCEDURE @SIRG; (* INCL (set, lo..hi) *)⓪"BEGIN⓪$ASSEMBLER⓪(; A0: ^Set, D0: lo, D1: hi, D2: Size(set), A1,A2 frei⓪(; A0 nicht zerstören!⓪(CMP D1,D0⓪(BHI.W over ; Lo > Hi⓪(⓪(LSL #3,D2⓪(CMP D2,D1⓪(BCS sizeOK⓪(MOVE D2,D1⓪(SUBQ #1,D1⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -6-$4000 ; Out of range⓪(UNLK A5⓪&sizeOK⓪(⓪(MOVE.L A0,A2⓪(MOVE.L A0,A1⓪(MOVE D0,D2⓪(LSR #3,D2⓪(ADDA.W D2,A2⓪(MOVE D1,D2⓪(LSR #3,D2⓪(ADDA.W D2,A1⓪(⓪(ANDI #7,D0⓪(ANDI #7,D1⓪(⓪(CMPA.L A2,A1⓪(BEQ lastByte⓪(⓪(; das erste Byte mit einzelnen BSETs setzen, wenn es nicht vollst.⓪(; gefüllt wird⓪(TST D0⓪(BEQ fullByte⓪(⓪(MOVE.B (A2),D2⓪&partByte⓪(BSET D0,D2⓪(ADDQ #1,D0⓪(CMPI.B #8,D0⓪(BNE partByte⓪(MOVE.B D2,(A2)+⓪(CLR D0⓪(⓪(CMPA.L A2,A1⓪(BEQ lastByte⓪(⓪&fullByte⓪(MOVE.L A1,D2⓪(SUB.L A2,D2⓪(SUBQ #1,D2⓪&fullFill⓪(MOVE.B #$FF,(A2)+⓪(DBRA D2,fullFill⓪(⓪&lastByte⓪(CMPI #7,D1⓪(BEQ lastFull⓪(⓪(MOVE.B (A2),D2⓪&lastLoop⓪(BSET D0,D2⓪(ADDQ #1,D0⓪(CMP D1,D0⓪(BLS lastLoop⓪(MOVE.B D2,(A2)⓪(BRA ende⓪(⓪&lastFull⓪(MOVE.B #$FF,(A2)⓪(⓪&ende⓪(⓪&over ; Lo > Hi⓪$END⓪"END @SIRG;⓪ ⓪ PROCEDURE @SMEM; (* IN-Operator auf Sets *)⓪"BEGIN⓪$ASSEMBLER⓪(; A0: Ptr auf Set; D1.W: Länge des Sets in Bytes;⓪(; D0.W: Element; D2 frei;⓪(; Ergebnis in Z-Flag: ne -> TRUE⓪(; Die Routine ist für variable Elementnr. vorgesehen und dazu wird⓪(; hierin auch geprüft, ob die Elementnr. außerhalb des Sets liegt.⓪(; Bei konstanter Elementnr. sollte dagegen der Code direkt erzeugt⓪(; werden.⓪(MOVE.W D0,D2⓪(LSR.W #3,D0⓪(CMP.W D1,D0⓪(BCC NOMEM⓪(BTST D2,0(A0,D0.W)⓪(RTS⓪&NOMEM⓪(MOVEQ #0,D1 ; FALSE (eq)⓪$END⓪"END @SMEM;⓪ ⓪ PROCEDURE @SEQL; (* '=' auf Sets *)⓪"BEGIN⓪$ASSEMBLER⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Bytes - 1 DIV 2⓪(; Ergebnis in Z-Flag: eq -> TRUE⓪&L CMPM.W (A0)+,(A1)+⓪(DBNE D0,L⓪$END⓪"END @SEQL;⓪ ⓪ PROCEDURE @SLEQ; (* '<=' auf Sets *)⓪"BEGIN⓪$ASSEMBLER⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; D1 ist frei; Ergebnis in Z-Flag⓪&L MOVE (A1)+,D1⓪(NOT D1⓪(AND (A0)+,D1⓪(DBNE D0,L⓪$END⓪"END @SLEQ;⓪ ⓪ ⓪ PROCEDURE @SAN1; (* '*' auf Sets *)⓪"BEGIN⓪$ASSEMBLER⓪(; rechter Wert auf A3, linker in Var -> auf A3 überschreiben⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; A1: Ziel-Set; D1 frei⓪&L MOVE (A0),D1⓪(AND D1,(A1)+⓪(DBRA D0,L⓪$END⓪"END @SAN1;⓪ ⓪ PROCEDURE @SAN2;⓪"BEGIN⓪$ASSEMBLER⓪(; linker Wert schon auf A3, rechter in Var -> auf A3 überschreiben⓪(; auch verwenden, wenn rechter auf A3: dann erst A3 korrigieren⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; A0: Ziel-Set; D1 frei⓪&L MOVE (A1)+,D1⓪(AND D1,(A0)+⓪(DBRA D0,L⓪$END⓪"END @SAN2;⓪ ⓪ PROCEDURE @SAND;⓪"BEGIN⓪$ASSEMBLER⓪(; beide Wert in Vars -> Erg. nach (A3)+⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; D1 frei⓪&L MOVE (A1)+,D1⓪(AND (A0)+,D1⓪(MOVE D1,(A3)+⓪(DBRA D0,L⓪$END⓪"END @SAND;⓪ ⓪ PROCEDURE @SXO1; (* '/' auf Sets *)⓪"BEGIN⓪$ASSEMBLER⓪(; rechter Wert auf A3, linker in Var -> auf A3 überschreiben⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; A1: Ziel-Set; D1 frei⓪&L MOVE (A0),D1⓪(EOR D1,(A1)+⓪(DBRA D0,L⓪$END⓪"END @SXO1;⓪ ⓪ PROCEDURE @SXO2;⓪"BEGIN⓪$ASSEMBLER⓪(; linker Wert schon auf A3, rechter in Var -> auf A3 überschreiben⓪(; auch verwenden, wenn rechter auf A3: dann erst A3 korrigieren⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; A0: Ziel-Set; D1 frei⓪&L MOVE (A1)+,D1⓪(EOR D1,(A0)+⓪(DBRA D0,L⓪$END⓪"END @SXO2;⓪ ⓪ PROCEDURE @SXOR;⓪"BEGIN⓪$ASSEMBLER⓪(; beide Wert in Vars -> Erg. nach (A3)+⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; D1,D2 frei⓪&L MOVE (A1)+,D1⓪(MOVE (A0)+,D2⓪(EOR D2,D1⓪(MOVE D1,(A3)+⓪(DBRA D0,L⓪$END⓪"END @SXOR;⓪ ⓪ PROCEDURE @SSU1; (* '+' auf Sets *)⓪"BEGIN⓪$ASSEMBLER⓪(; rechter Wert auf A3, linker in Var -> auf A3 überschreiben⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; A1: Ziel-Set; D1 frei⓪&L MOVE (A0),D1⓪(OR D1,(A1)+⓪(DBRA D0,L⓪$END⓪"END @SSU1;⓪ ⓪ PROCEDURE @SSU2;⓪"BEGIN⓪$ASSEMBLER⓪(; linker Wert schon auf A3, rechter in Var -> auf A3 überschreiben⓪(; auch verwenden, wenn rechter auf A3: dann erst A3 korrigieren⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; A0: Ziel-Set; D1 frei⓪&L MOVE (A1)+,D1⓪(OR D1,(A0)+⓪(DBRA D0,L⓪$END⓪"END @SSU2;⓪ ⓪ PROCEDURE @SSUM;⓪"BEGIN⓪$ASSEMBLER⓪(; beide Wert in Vars -> Erg. nach (A3)+⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; D1 frei⓪&L MOVE (A1)+,D1⓪(OR (A0)+,D1⓪(MOVE D1,(A3)+⓪(DBRA D0,L⓪$END⓪"END @SSUM;⓪ ⓪ PROCEDURE @SDI1; (* '-' auf Sets *)⓪ BEGIN⓪$ASSEMBLER⓪(; rechter Wert auf A3, linker in Var -> auf A3 überschreiben⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; A1: Ziel-Set; D1 frei⓪&L MOVE (A1),D1⓪(NOT D1⓪(AND (A0)+,D1⓪(MOVE D1,(A1)+⓪(DBRA D0,L⓪$END⓪"END @SDI1;⓪ ⓪ PROCEDURE @SDI2;⓪"BEGIN⓪$ASSEMBLER⓪(; linker Wert schon auf A3, rechter in Var -> auf A3 überschreiben⓪(; auch verwenden, wenn rechter auf A3: dann erst A3 korrigieren⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; A0: Ziel-Set; D1 frei⓪&L MOVE (A1)+,D1⓪(NOT D1⓪(AND D1,(A0)+⓪(DBRA D0,L⓪$END⓪"END @SDI2;⓪ ⓪ PROCEDURE @SDIF;⓪"BEGIN⓪$ASSEMBLER⓪(; beide Wert in Vars -> Erg. nach (A3)+⓪(; A0, A1: Ptr auf Sets; D0.W: Setlänge in Words - 1⓪(; D1 frei⓪&L MOVE (A1)+,D1⓪(NOT D1⓪(AND (A0)+,D1⓪(MOVE D1,(A3)+⓪(DBRA D0,L⓪$END⓪"END @SDIF;⓪ ⓪ ⓪ ⓪ (*********** Longint - Arithmetik ***********)⓪ ⓪ PROCEDURE @IMLW;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? Code20:⓪(EXT.L D1⓪(MULS.L D1,D0⓪ *)⓪ (*$? NOT Code20:⓪(; D1 muß positiv und <= MaxInt sein!⓪(TST.L D0⓪(BPL.S mul⓪(NEG.L D0⓪(BSR.S mul⓪(BVS ende⓪(NEG.L D0⓪!ende RTS⓪!mul MOVE.W D0,D2⓪(MULU D1,D2 ; loD1 * loD0⓪(SWAP D0⓪(MULU D1,D0 ; loD1 * hiD0⓪(SWAP D0⓪(TST.W D0⓪(BNE.S over⓪(ADD.L D2,D0⓪(BMI over⓪(RTS⓪!over MOVEQ #0,D0⓪(ORI #2,CCR ; Overflow-Bit setzen⓪ *)⓪$END⓪"END @IMLW;⓪ ⓪ PROCEDURE @CMLW;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? Code20:⓪(MOVEQ #0,D2⓪(MOVE.W D1,D2⓪(MULU.L D2,D0⓪(BVS over⓪(RTS⓪ *)⓪ (*$? NOT Code20:⓪(MOVE.W D0,D2⓪(MULU D1,D2 ; loD1 * loD0⓪(SWAP D0⓪(MULU D1,D0 ; loD1 * hiD0⓪(SWAP D0⓪(TST.W D0⓪(BNE.S over⓪(ADD.L D2,D0⓪(RTS⓪ *)⓪!over MOVEQ #0,D0⓪(ORI #1,CCR ; Carry-Bit setzen⓪$END⓪"END @CMLW;⓪ ⓪ PROCEDURE @IDVW;⓪"BEGIN⓪$ASSEMBLER⓪(; D1 darf nicht Null sein⓪ (*$? Code20:⓪(EXT.L D1⓪(DIVS.L D1,D0⓪ *)⓪ (*$? NOT Code20:⓪(; D0.L := D0.L / D1.W⓪(DIVS D1,D0 ; erstmal probiern, ob's so geht⓪(BVS over⓪(EXT.L D0⓪(RTS⓪&over ; ging nicht -> dann eben anders⓪(; das geht so:⓪(; ab / c = ?⓪(; zuerst wird a/c gerechnet, das Erg. als High-Word genommen.⓪(; ein Überlauf kann dabei nicht auftreten.⓪(; dann wird der Rest genommen, ins High-Word getan, b aufaddiert⓪(; und das wieder durch c geteilt. Das ist dann das Low-Word des⓪(; Ergebnisses. Ein Überlauf dürfte auch hier nicht auftreten.⓪(SWAP D0 ; b retten, a ins Low-Word laden⓪(MOVE.W D0,D2⓪(EXT.L D2⓪(DIVS D1,D2 ; a / c : D2.uW = Rest, D2.lW = Erg.⓪(MOVE.W D2,D0 ; 1. Teil vom Erg.⓪(SWAP D0 ; b zurück, High-Word vom Erg. setzen⓪(MOVE.W D0,D2 ; 'b' auf Rest addieren⓪(DIVU D1,D2 ; b / c⓪(MOVE D2,D0 ; Low-Word vom Erg. einsetzen⓪ *)⓪$END⓪"END @IDVW;⓪ ⓪ PROCEDURE @CDVW;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? Code20:⓪(MOVEQ #0,D2⓪(MOVE.W D1,D2⓪(DIVU.L D2,D0⓪ *)⓪ (*$? NOT Code20:⓪(; D0.L := D0.L / D1.W⓪(DIVU D1,D0 ; erstmal probiern, ob's so geht⓪(BVS over⓪(SWAP D0⓪(CLR.W D0⓪(SWAP D0⓪(RTS⓪&over ; ging nicht -> dann eben anders⓪(SWAP D0 ; b retten, a ins Low-Word laden⓪(MOVEQ #0,D2⓪(MOVE.W D0,D2⓪(DIVU D1,D2 ; a / c : D2.uW = Rest, D2.lW = Erg.⓪(MOVE.W D2,D0 ; 1. Teil vom Erg.⓪(SWAP D0 ; b zurück, High-Word vom Erg. setzen⓪(MOVE.W D0,D2 ; 'b' auf Rest addieren⓪(DIVU D1,D2 ; b / c⓪(MOVE D2,D0 ; Low-Word vom Erg. einsetzen⓪ *)⓪$END⓪"END @CDVW;⓪ ⓪ PROCEDURE @IMDW;⓪"BEGIN⓪$ASSEMBLER⓪(; D0.L := D0.L MOD D1.W (D1#0)⓪ (*$? Code20:⓪(EXT.L D1⓪(DIVSL.L D1,D1:D0⓪(MOVE.L D1,D0⓪ *)⓪ (*$? NOT Code20:⓪(DIVS D1,D0 ; erstmal probiern, ob's so geht⓪(BVS over⓪(SWAP D0 ; Erg. paßt immer in WORD⓪(EXT.L D0⓪(RTS⓪&over ; ging nicht -> dann eben anders⓪(; das geht so:⓪(; ab / c = ? -> Rest liefern⓪(; zuerst wird a/c gerechnet. ein Überlauf kann dabei nicht auftreten.⓪(; dann wird der Rest genommen, ins High-Word getan, b aufaddiert⓪(; und das wieder durch c geteilt. Nun haben wir den Rest im High-Word,⓪(; der nur noch umgeladen werden muß (das Erg. ist IMMER Word-Size!)⓪(MOVE.W D0,D2 ; b retten⓪(SWAP D0 ; a ins Low-Word laden⓪(EXT.L D0⓪(DIVS D1,D0 ; a / c : D0.uW = Rest⓪(MOVE.W D2,D0 ; 'b' auf Rest addieren⓪(DIVS D1,D0 ; b / c⓪(SWAP D0 ; High-Word (Rest) als Erg. liefern⓪(EXT.L D0⓪ *)⓪$END⓪"END @IMDW;⓪ ⓪ PROCEDURE @CMDW;⓪"BEGIN⓪$ASSEMBLER⓪(; D0.L := D0.L MOD D1.W (D1#0)⓪ (*$? Code20:⓪(MOVEQ #0,D2⓪(MOVE.W D1,D2⓪(DIVUL.L D2,D1:D0⓪(MOVE.L D1,D0⓪ *)⓪ (*$? NOT Code20:⓪(DIVU D1,D0 ; erstmal probiern, ob's so geht⓪(BVS over⓪(CLR.W D0⓪(SWAP D0 ; Erg. paßt immer in WORD⓪(RTS⓪&over ; ging nicht -> dann eben anders⓪(; das geht so:⓪(; ab / c = ? -> Rest liefern⓪(; zuerst wird a/c gerechnet. ein Überlauf kann dabei nicht auftreten.⓪(; dann wird der Rest genommen, ins High-Word getan, b aufaddiert⓪(; und das wieder durch c geteilt. Nun haben wir den Rest im High-Word,⓪(; der nur noch umgeladen werden muß (das Erg. ist IMMER Word-Size!)⓪(MOVE.W D0,D2 ; b retten⓪(CLR.W D0⓪(SWAP D0 ; a ins Low-Word laden⓪(DIVU D1,D0 ; a / c : D0.uW = Rest⓪(MOVE.W D2,D0 ; 'b' auf Rest addieren⓪(DIVU D1,D0 ; b / c⓪(CLR.W D0⓪(SWAP D0 ; High-Word (Rest) als Erg. liefern⓪ *)⓪$END⓪"END @CMDW;⓪ ⓪ PROCEDURE @IMLL;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? Code20:⓪(MULS.L D1,D0⓪ *)⓪ (*$? NOT Code20:⓪(TST.L D0⓪(BPL.S l1⓪(NEG.L D0⓪(TST.L D1⓪(BPL.S l2⓪(NEG.L D1⓪(BRA.S mul⓪%l1 TST.L D1⓪(BPL.S mul⓪(NEG.L D1⓪%l2 BSR.S mul⓪(BVS ende⓪(NEG.L D0⓪#ende RTS⓪ ⓪$mul MOVE.W D0,D2⓪(MULU D1,D2 ; loD1 * loD0⓪(SWAP D0⓪(TST.W D0⓪(BEQ.S d0word ; hiD0 = 0 -> hiD1 * loD0 ⓪(MULU D1,D0 ; loD1 * hiD0⓪(SWAP D0⓪(TST.W D0⓪(BNE.S over⓪(SWAP D1⓪(TST.W D1⓪(BNE over ; hiD1 # 0 -> overflow⓪(ADD.L D2,D0⓪(BMI over⓪(RTS⓪!d0word SWAP D0⓪(SWAP D1⓪(MULU D1,D0 ; hiD1 * loD0⓪(SWAP D0⓪(TST.W D0⓪(BNE over⓪(ADD.L D2,D0⓪(BMI over⓪(RTS⓪!over MOVEQ #0,D0⓪(ORI #2,CCR ; Overflow-Bit setzen⓪ *)⓪$END⓪"END @IMLL;⓪ ⓪ PROCEDURE @CMLL;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? Code20:⓪(MULU.L D1,D0⓪(BVS over⓪(RTS⓪ *)⓪ (*$? NOT Code20:⓪(MOVE.W D0,D2⓪(MULU D1,D2 ; loD1 * loD0⓪(SWAP D0⓪(TST.W D0⓪(BEQ.S d0word ; hiD0 = 0 -> hiD1 * loD0 ⓪(MULU D1,D0 ; loD1 * hiD0⓪(SWAP D0⓪(TST.W D0⓪(BNE.S over⓪(SWAP D1⓪(TST.W D1⓪(BNE over ; hiD1 # 0 -> overflow⓪(ADD.L D2,D0⓪(RTS⓪!d0word SWAP D0⓪(SWAP D1⓪(MULU D1,D0 ; hiD1 * loD0⓪(SWAP D0⓪(TST.W D0⓪(BNE over⓪(ADD.L D2,D0⓪(RTS⓪ *)⓪!over MOVEQ #0,D0⓪(ORI #1,CCR ; Carry-Bit setzen⓪$END⓪"END @CMLL;⓪ ⓪ ⓪ PROCEDURE @IDVL;⓪ BEGIN⓪#ASSEMBLER⓪ (*$? Code20:⓪(TST.L D1⓪(BEQ zero⓪(DIVS.L D1,D0⓪(RTS⓪ *)⓪ (*$? NOT Code20:⓪(MOVEM.L D4-D5,-(A7)⓪(CLR.W D5⓪(TST.L D1⓪(BEQ IDERR⓪(BPL IDIV5⓪(NEG.L D1⓪(MOVEQ #1,D5⓪ !IDIV5 TST.L D0⓪(BPL IDIV6⓪(NEG.L D0⓪(BCHG #0,D5⓪ !IDIV6 CLR.L D2⓪(CLR.L D4⓪(CMP.L D1,D0⓪(BLS IDIV2⓪ !IDIV1 ADD.L D1,D1⓪(ADDQ.W #1,D2⓪(CMP.L D1,D0⓪(BHI IDIV1⓪(BRA IDIV2⓪ !IDIV3 LSR.L #1,D1⓪ !IDIV2 ADD.L D4,D4⓪(CMP.L D1,D0⓪(BCS IDIV4⓪(SUB.L D1,D0⓪(ADDQ.W #1,D4⓪ !IDIV4 DBF D2,IDIV3⓪(TST.W D5⓪(BEQ IDIV7⓪(NEG.L D4⓪ !IDIV7 MOVE.L D4,D0⓪(MOVEM.L (A7)+,D4-D5⓪(RTS⓪(⓪ !IDERR MOVEM.L (A7)+,D4-D5⓪ *)⓪ zero LINK A5,#0⓪(TRAP #6 ; Div by zero⓪(DC.W -5-$4000⓪(MOVEQ #0,D0⓪(UNLK A5⓪$END⓪ END @IDVL;⓪ ⓪ PROCEDURE @CDVL;⓪ BEGIN⓪ ASSEMBLER⓪ (*$? Code20:⓪(TST.L D1⓪(BEQ zero⓪(DIVU.L D1,D0⓪(RTS⓪ *)⓪ (*$? NOT Code20:⓪'MOVE.L D3,-(A7)⓪'TST.L D1⓪'BEQ CDERR⓪'CLR.L D2⓪'CLR.L D3⓪'TST.L D1⓪'BMI CDIV2⓪ !CDIV1 CMP.L D1,D0⓪'BLS CDIV2⓪'ADDQ #1,D2⓪'ADD.L D1,D1⓪'BPL CDIV1⓪ !CDIV2 ADD.L D3,D3⓪'CMP.L D1,D0⓪'BCS CDIV3⓪'SUB.L D1,D0⓪'ADDQ #1,D3⓪ !CDIV3 LSR.L #1,D1⓪'DBF D2,CDIV2⓪'MOVE.L D3,D0⓪'MOVE.L (A7)+,D3⓪'RTS⓪'⓪ !CDERR MOVE.L (A7)+,D3⓪ *)⓪ zero LINK A5,#0⓪'TRAP #6 ; Div by zero⓪'DC.W -5-$4000⓪'MOVEQ #0,D0⓪'UNLK A5⓪ END⓪ END @CDVL;⓪ ⓪ PROCEDURE @IMDL;⓪ BEGIN⓪ ASSEMBLER⓪ (*$? Code20:⓪(TST.L D1⓪(BEQ zero⓪(DIVSL.L D1,D1:D0⓪(MOVE.L D1,D0⓪(RTS⓪ *)⓪ (*$? NOT Code20:⓪'MOVE.L D5,-(A7)⓪'CLR.W D5⓪'CLR.L D2⓪'TST.L D1⓪'BEQ IMODER⓪'BPL IMOD2⓪'NEG.L D1⓪ !IMOD2 TST.L D0⓪'BPL IMOD1⓪'NEG.L D0⓪'MOVEQ #1,D5⓪'CMP.L D1,D0⓪'BLS IMOD5⓪ !IMOD1 ADD.L D1,D1⓪'ADDQ.W #1,D2⓪'CMP.L D1,D0⓪'BHI IMOD1⓪'BRA IMOD5⓪ !IMOD3 LSR.L #1,D1⓪ !IMOD5 CMP.L D1,D0⓪'BCS IMOD4⓪'SUB.L D1,D0⓪ !IMOD4 DBEQ D2,IMOD3⓪'TST.W D5⓪'BEQ IMOD6⓪'NEG.L D0⓪ !IMOD6 MOVE.L (A7)+,D5⓪'RTS⓪'⓪ IMODER MOVE.L (A7)+,D5⓪ *)⓪ zero LINK A5,#0⓪'TRAP #6 ; Div by zero⓪'DC.W -5-$4000⓪'MOVEQ #0,D0⓪'UNLK A5⓪#END⓪ END @IMDL;⓪ ⓪ PROCEDURE @CMDL;⓪ BEGIN⓪ ASSEMBLER⓪ (*$? Code20:⓪(TST.L D1⓪(BEQ zero⓪(DIVUL.L D1,D1:D0⓪(MOVE.L D1,D0⓪(RTS⓪ *)⓪ (*$? NOT Code20:⓪'MOVE.L D3,-(A7)⓪'TST.L D1⓪'BEQ CMERR⓪'CLR.L D2⓪'MOVE.L D1,D3⓪'BMI CMOD2⓪ !CMOD1 CMP.L D1,D0⓪'BLS CMOD2⓪'ADDQ #1,D2⓪'ADD.L D1,D1⓪'BPL CMOD1⓪ !CMOD2 CMP.L D1,D0⓪'BCS CMOD3⓪'SUB.L D1,D0⓪ !CMOD3 LSR.L #1,D1⓪'CMP.L D0,D3⓪'DBHI D2,CMOD2⓪'⓪'MOVE.L (A7)+,D3⓪'RTS⓪'⓪ !CMERR MOVE.L (A7)+,D3⓪ *)⓪ zero LINK A5,#0⓪'TRAP #6 ; Div by zero⓪'DC.W -5-$4000⓪'MOVEQ #0,D0⓪'UNLK A5⓪#END⓪ END @CMDL;⓪ ⓪ ⓪ PROCEDURE @IMUL (a,b:LONGINT):LONGINT;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),D1⓪(MOVE.L -(A3),D0⓪(JSR @IMLL⓪(MOVE.L D0,(A3)+⓪$END⓪"END @IMUL;⓪ ⓪ PROCEDURE @CMUL (a,b:LONGCARD):LONGCARD;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),D1⓪(MOVE.L -(A3),D0⓪(JSR @CMLL⓪(MOVE.L D0,(A3)+⓪$END⓪"END @CMUL;⓪ ⓪ PROCEDURE @IDIV (a,b:LONGINT):LONGINT;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),D1⓪(MOVE.L -(A3),D0⓪(JSR @IDVL⓪(MOVE.L D0,(A3)+⓪$END⓪"END @IDIV;⓪ ⓪ PROCEDURE @CDIV (a,b:LONGCARD):LONGCARD;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),D1⓪(MOVE.L -(A3),D0⓪(JSR @CDVL⓪(MOVE.L D0,(A3)+⓪$END⓪"END @CDIV;⓪ ⓪ PROCEDURE @IMOD (a,b:LONGINT):LONGINT;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),D1⓪(MOVE.L -(A3),D0⓪(JSR @IMDL⓪(MOVE.L D0,(A3)+⓪$END⓪"END @IMOD;⓪ ⓪ PROCEDURE @CMOD (a,b:LONGCARD):LONGCARD;⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),D1⓪(MOVE.L -(A3),D0⓪(JSR @CMDL⓪(MOVE.L D0,(A3)+⓪$END⓪"END @CMOD;⓪ ⓪ ⓪ PROCEDURE @STAS;⓪ (* D0: LAENGE DES SOURCESTRING/BYTE; D1: LAENGE DEST.STRING/BYTE *)⓪ BEGIN⓪#ASSEMBLER⓪'JMP HALT⓪ (*⓪'MOVE.L A3,A0⓪'MOVE.L D0,D2⓪'ADDQ.L #1,D0 ; D0 als StackOffset: muss synch. werden!⓪'ANDI.W #$FFFE,D0 ; nicht BCLR verwenden, sonst Fehler bei DBEQ (unten)⓪'SUBA.L D0,A0 ; A0 zeigt auf Sourcestring⓪'BRA y⓪$⓪$z SWAP D1 ;*** Kopierschleife⓪$x SUBQ.L #1,D2⓪'BCS ok2 ; Source-Ende, Dest. muss Endmarke bekommen⓪'MOVE.B (A0)+,(A4)+⓪$y DBEQ D1,x⓪'BEQ ok ; Endmarke der Source wurde eben kopiert⓪'SWAP D1⓪'DBF D1,z⓪'⓪'TST.L D2 ;*** Ende der Schleife, weil Dest voll⓪'BEQ ok ; Source komplett kopiert (hatte keine Endmarke)⓪'TST.B (A0)⓪'BEQ ok ; sonst muss die Endmarke das naechste Zeichen sein⓪'SUBA.L D0,A3 ; leider nein: String Overflow⓪'TRAP #6⓪'DC.W -8-$4000⓪#ok2 CLR.B (A4)+⓪#ok SUBA.L D0,A3⓪ *)⓪#END⓪ END @STAS;⓪ ⓪ (* ************************************************************************ *)⓪ (*⓪!* Kopieren von Open Arrays⓪!*)⓪ ⓪ PROCEDURE @CWOP;⓪"BEGIN⓪$ASSEMBLER⓪(; Byte-Open Array auf Stack kopieren: Ptr/High auf A3, Daten auf A7⓪(; A0: Ptr auf Source-Desc aus Ptr und High.W, D0 nicht benutzen,⓪(; D1/D2/A1/A2 frei⓪(MOVE.L (A0)+,A1 ; Ptr auf Source-Array⓪(MOVE.W (A0),D1 ; HIGH⓪(⓪(ADDQ.L #4,A3⓪(MOVE.W D1,(A3)+⓪(⓪(LSR.W #1,D1 ; HIGH durch 2 teilen f. Kopierschl. m. 2 Bytes⓪(⓪(; HIGH / 2 + 1 * 2 von A7 als Ziel-Stack abziehen⓪(MOVE.L (A7)+,A2⓪(MOVEQ #0,D2⓪(MOVE D1,D2⓪(ADDQ.W #1,D2⓪(ADD.L D2,D2⓪(SUBA.L D2,A7⓪(MOVE.L A7,A0⓪(⓪(MOVE.L A7,-6(A3)⓪(⓪(MOVE.W A1,D2 ; bei gerader Adr. Words kopieren⓪(LSR.W #1,D2⓪(BCS.S ODDL⓪(⓪&EVL⓪(MOVE.W (A1)+,(A0)+⓪(DBRA D1,EVL⓪(JMP (A2)⓪(⓪&ODDL⓪(MOVE.B (A1)+,(A0)+⓪(MOVE.B (A1)+,(A0)+⓪(DBRA D1,ODDL⓪(JMP (A2)⓪$END⓪"END @CWOP;⓪ ⓪ PROCEDURE @CLOP;⓪"BEGIN⓪$ASSEMBLER⓪(; Byte-Open Array auf Stack kopieren: Ptr/High auf A3, Daten auf A7⓪(; A0: Ptr auf Source-Desc aus Ptr und High.L, D0 nicht benutzen,⓪(; D1/D2/A1/A2 frei⓪(MOVE.L (A0)+,A1 ; Ptr auf Source-Array⓪(MOVE.L (A0),D1 ; HIGH⓪(⓪(ADDQ.L #4,A3⓪(MOVE.L D1,(A3)+⓪(⓪(LSR.L #1,D1 ; HIGH durch 2 teilen f. Kopierschl. m. 2 Bytes⓪(⓪(; HIGH / 2 + 1 * 2 von A7 als Ziel-Stack abziehen⓪(MOVE.L (A7)+,A2⓪(MOVE.L D1,D2⓪(ADDQ.L #1,D2⓪(ADD.L D2,D2⓪(SUBA.L D2,A7⓪(MOVE.L A7,A0⓪(⓪(MOVE.L A7,-8(A3)⓪(⓪(MOVE.W A1,D2 ; bei gerader Adr. Words kopieren⓪(LSR.W #1,D2⓪(BCC.S EVL⓪(BRA.S ODDL⓪(⓪&ODDL2⓪(SWAP D1⓪&ODDL⓪(MOVE.B (A1)+,(A0)+⓪(MOVE.B (A1)+,(A0)+⓪(DBRA D1,ODDL⓪(SWAP D1⓪(DBRA D1,ODDL2⓪(JMP (A2)⓪(⓪&EVL2⓪(SWAP D1⓪&EVL⓪(MOVE.W (A1)+,(A0)+⓪(DBRA D1,EVL⓪(SWAP D1⓪(DBRA D1,EVL2⓪(JMP (A2)⓪$END⓪"END @CLOP;⓪ ⓪ PROCEDURE @PS7B;⓪"BEGIN⓪$ASSEMBLER⓪(; -- push onto A7 --⓪(; A0: addr of ptr to copied data⓪(; A1: source⓪(; D2,A2: free⓪(; D1.L: count⓪(⓪(move.l (a7)+,A2 ;Ruecksprung-Adr⓪(⓪(; Platzbedarf ausrechnen⓪(⓪(addq.l #1,d1 ;länge in byte synchronisieren⓪(bclr #0,d1⓪(⓪(; Platz reservieren, Pointer bereitstellen⓪&⓪(suba.l d1,a7⓪(move.l a7,(a0)⓪(movea.l a7,a0 ;^ fuer Kopierschleife⓪(⓪(; Kopierschleife⓪(⓪(bra lp2⓪#lp1 swap d1⓪#lp move.b (A1)+,(a0)+ ;schoen langsam umkopieren...⓪#lp2 dbf d1,lp⓪(swap d1⓪(dbf d1,lp1⓪(⓪(jmp (A2) ;zurueck zum Aufrufer⓪$END⓪"END @PS7B;⓪ ⓪ PROCEDURE @PS7W;⓪"BEGIN⓪$ASSEMBLER⓪(; -- push onto A7 --⓪(; A0: addr of ptr to copied data⓪(; A1: source⓪(; D2,A2: free⓪(; D1.L: count⓪(⓪(move.l (a7)+,A2 ;Ruecksprung-Adr⓪(⓪(; Platz reservieren, Pointer bereitstellen⓪&⓪(move.l d1,d2⓪(add.l d2,d2⓪(suba.l d2,a7⓪(move.l a7,(a0)⓪(movea.l a7,a0 ;^ fuer Kopierschleife⓪(⓪(; Kopierschleife⓪(⓪(bra lp2⓪#lp1 swap d1⓪#lp move.w (A1)+,(a0)+⓪#lp2 dbf d1,lp⓪(swap d1⓪(dbf d1,lp1⓪(⓪(jmp (A2) ;zurueck zum Aufrufer⓪$END⓪"END @PS7W;⓪ ⓪ PROCEDURE @PS7L;⓪"BEGIN⓪$ASSEMBLER⓪(; -- push onto A7 --⓪(; A0: addr of ptr to copied data⓪(; A1: source⓪(; D2,A2: free⓪(; D1.L: count⓪(⓪(move.l (a7)+,A2 ;Ruecksprung-Adr⓪(⓪(; Platz reservieren, Pointer bereitstellen⓪&⓪(move.l d1,d2⓪(lsl.l #2,d2⓪(suba.l d2,a7⓪(move.l a7,(a0)⓪(movea.l a7,a0 ;^ fuer Kopierschleife⓪(⓪(; Kopierschleife⓪(⓪(bra lp2⓪#lp1 swap d1⓪#lp move.l (A1)+,(a0)+⓪#lp2 dbf d1,lp⓪(swap d1⓪(dbf d1,lp1⓪(⓪(jmp (A2) ;zurueck zum Aufrufer⓪$END⓪"END @PS7L;⓪ ⓪ ⓪ PROCEDURE @PS3B;⓪"BEGIN⓪$ASSEMBLER⓪(; -- push onto A3 --⓪(; A1: source⓪(; D1.L: count⓪(⓪(; Kopierschleife⓪(⓪(addq.l #1,d1 ;länge in byte synchronisieren⓪(bclr #0,d1⓪(⓪(bra lp2⓪#lp1 swap d1⓪#lp move.b (A1)+,(a3)+ ;schön langsam umkopieren...⓪#lp2 dbf d1,lp⓪(swap d1⓪(dbf d1,lp1⓪$END⓪"END @PS3B;⓪ ⓪ PROCEDURE @PS3W;⓪"BEGIN⓪$ASSEMBLER⓪(; -- push onto A3 --⓪(; A1: source⓪(; D1.L: count⓪(⓪(; Kopierschleife⓪(⓪(bra lp2⓪#lp1 swap d1⓪#lp move.w (A1)+,(a3)+⓪#lp2 dbf d1,lp⓪(swap d1⓪(dbf d1,lp1⓪$END⓪"END @PS3W;⓪ ⓪ PROCEDURE @PS3L;⓪"BEGIN⓪$ASSEMBLER⓪(; -- push onto A3 --⓪(; A1: source⓪(; D1.L: count⓪(⓪(; Kopierschleife⓪(⓪(bra lp2⓪#lp1 swap d1⓪#lp move.l (A1)+,(a3)+⓪#lp2 dbf d1,lp⓪(swap d1⓪(dbf d1,lp1⓪$END⓪"END @PS3L;⓪ ⓪ (* ************************************************************************ *)⓪ ⓪ PROCEDURE @COPW;⓪"BEGIN⓪$ASSEMBLER⓪(; A0: dest, A1: source, D0.W: bytes⓪(; D1 ist frei⓪(; A0 muß hinterher hinter Ziel zeigen!⓪(MOVE.W A0,D1⓪(LSR.W #1,D1⓪(BCS.S ODD0⓪(MOVE.W A1,D1⓪(LSR.W #1,D1⓪(BCC.S EVEN⓪(BRA.S ODD0⓪&ODDL⓪(MOVE.B (A1)+,(A0)+⓪&ODD0⓪(DBRA D0,ODDL⓪(RTS⓪&EVEN⓪(MOVE D0,D1⓪(ANDI #3,D1⓪(LSR.W #2,D0⓪(BRA EV2⓪&EVL⓪(MOVE.L (A1)+,(A0)+⓪&EV2⓪(DBRA D0,EVL⓪(DBRA D1,EV3⓪(RTS⓪&EV3⓪(MOVE.B (A1)+,(A0)+⓪(DBRA D1,EV3⓪$END⓪"END @COPW;⓪ ⓪ PROCEDURE @COPL;⓪"BEGIN⓪$ASSEMBLER⓪(; A0: dest, A1: source, D0.L: bytes⓪(; D1/D2/A2 sind frei⓪(; A0 muß hinterher hinter Ziel zeigen!⓪(MOVE.L A1,(A3)+⓪(MOVE.L D0,(A3)+⓪(MOVE.L A0,(A3)+⓪(ADDA.L D0,A0⓪(MOVE.L A0,-(A7)⓪(JSR Block.Copy⓪(MOVE.L (A7)+,A0⓪$END⓪"END @COPL;⓪ ⓪ (* ************************************************************************ *)⓪ ⓪ PROCEDURE @CAP;⓪ BEGIN⓪"ASSEMBLER⓪(LEA tab(PC),A2⓪(MOVE.B 0(A2,D0.W),D0⓪(RTS⓪"⓪"tab: DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F⓪(DC.B ' ','!','"','#','$','%','&',$27,'(',')','*','+',',','-','.','/'⓪(DC.B '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?'⓪(DC.B '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','[','\',']','^','_'⓪(DC.B '`','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','{','|','}','~',''⓪(DC.B 'Ç','Ü','É','A','Ä','À','Å','Ç','E','E','E','I','I','I','Ä','Å'⓪(DC.B 'É','Æ','Æ','O','Ö','O','U','U','ÿ','Ö','Ü','¢','£','¥','ß','ƒ'⓪(DC.B 'A','I','O','U','Ñ','Ñ','ª','º','¿','⌐','¬','½','¼','¡','«','»'⓪(DC.B 'Ã','Õ','Ø','Ø','Œ','Œ','À','Ã','Õ','¨','´','†','¶','©','®','™'⓪(DC.B 'Ĳ','Ĳ','א','ב','ג','ד','ה','ו','ז','ח','ט','י','כ','ל','מ','נ'⓪(DC.B 'ס','ע','פ','צ','ק','ר','ש','ת','ן','ך','ם','ף','ץ','§','∧','∞'⓪(DC.B 'α','β','Γ','π','Σ','σ','µ','τ','Φ','Θ','Ω','δ','∮','ϕ','∈','∩'⓪(DC.B '≡','±','≥','≤','⌠','⌡','÷','≈','°','∙','·','√','ⁿ','²','³','¯'⓪"END⓪ END @CAP;⓪ ⓪ ⓪ PROCEDURE HALT;⓪ BEGIN⓪"ASSEMBLER⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -11-$4000⓪(UNLK A5⓪"END⓪ END HALT;⓪ ⓪ ⓪ ⓪ PROCEDURE @LC2S; (* LC(D0.L) -> SR(D0.L) *)⓪ (*⓪#d0 (unsigned) -> d0 (ffp)⓪#FP2, d1 is destroyed⓪ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(; Da FMOVE immer mit Vorzeichen geschieht, muß der Wert gewandelt werden⓪(ADDI.L #$80000000,D0⓪(FMOVE.L D0,FP2⓪(FSUB.L #$80000000,FP2⓪(FMOVE.S FP2,D0⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft moveq #$df,d1 ; setup positive high exponent ($80+64+31)⓪(tst.l d0 ; integer a zero ?⓪(beq.s itortn ; return same result if so⓪(bmi.s itorti1 ; branch maximum negative number⓪(cmp.l #$00007fff,d0 ; possible 17 bits zero ?⓪(bhi.s itolp ; branch if not⓪(swap.w d0 ; quick shift by swap⓪(sub.b #16,d1 ; deduct 16 shifts from exponent⓪ itolp add.l d0,d0 ; shift mantissa up⓪(dbmi d1,itolp ; loop until normalized⓪(tst.b d0 ; test for round up⓪(bpl.s itorti2 ; branch no rounding needed⓪(add.l #$100,d0 ; round up⓪(bcc.s itorti2 ; branch no overflow⓪(roxr.l #1,d0 ; adjust down one bit⓪ itorti1 addq.b #1,d1 ; reflect right shift in exponent bias⓪ itorti2 move.b d1,d0 ; insert sign & exponent⓪ itortn RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(; Da FMOVE immer mit Vorzeichen geschieht, muß der Wert gewandelt werden⓪(ADDI.L #$80000000,D0⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(; FMOVE.L D0,FP2 ; kein Runtime-Fehler möglich⓪(MOVE.W #$4100,fpcmd⓪(MOVE.W fpstat,D1⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L D0,fpop⓪(TST.W fpstat⓪(; FSUB.L #$80000000,FP2⓪(MOVE.W #$4128,fpcmd⓪ DoDl2 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ DoDl2⓪(MOVE.L #$80000000,fpop⓪(TST.W fpstat⓪(MOVE.W #$6500,fpcmd ; FMOVE.S FP2,D0⓪ DoDl3 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ DoDl3⓪(MOVE.L fpop,D0⓪(TST.W fpstat⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L D0⓪ *)⓪$END⓪"END @LC2S;⓪ ⓪ PROCEDURE @LI2S; (* LI(D0.L) -> SR(D0.L) *)⓪ (*⓪#d0 (integer 2's complement) -> d0 (ffp)⓪#fp2, d1 is destroyed⓪ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE.L D0,FP2 ; kein Runtime-Fehler möglich⓪(FMOVE.S FP2,D0⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft moveq #$df,d1 ; setup positive high exponent ($80+64+31)⓪(tst.l d0 ; integer a zero ?⓪(beq.s itortn ; return same result if so⓪(bpl.s itopls ; branch if positive integer⓪(moveq #$5f,d1 ; setup negative high exponent 64+31⓪(neg.l d0 ; find positive value⓪(bvs.s itorti2 ; branch maximum negative number⓪ itopls cmp.l #$00007fff,d0 ; possible 17 bits zero ?⓪(bhi.s itolp ; branch if not⓪(swap.w d0 ; quick shift by swap⓪(sub.b #16,d1 ; deduct 16 shifts from exponent⓪ itolp add.l d0,d0 ; shift mantissa up⓪(dbmi d1,itolp ; loop until normalized⓪(tst.b d0 ; test for round up⓪(bpl.s itorti ; branch no rounding needed⓪(add.l #$100,d0 ; round up⓪(bcc.s itorti ; branch no overflow⓪(roxr.l #1,d0 ; adjust down one bit⓪ itorti2 addq.b #1,d1 ; reflect right shift in exponent bias⓪ itorti move.b d1,d0 ; insert sign & exponent⓪ itortn RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(; FMOVE.L D0,FP2 ; kein Runtime-Fehler möglich⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(MOVE.W #$4100,fpcmd⓪(MOVE.W fpstat,D1⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L D0,fpop⓪(TST.W fpstat⓪(; FMOVE.S FP2,D0⓪(MOVE.W #$6500,fpcmd⓪ DoDl3 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl3⓪(MOVE.L fpop,D0⓪(TST.W fpstat⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L D0⓪ *)⓪$END⓪"END @LI2S;⓪ ⓪ ⓪ PROCEDURE @LC2D; (* LC(D0.L) -> LR(A0) /D1,FP2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(; Da FMOVE immer mit Vorzeichen geschieht, muß der Wert gewandelt werden⓪(ADDI.L #$80000000,D0⓪(FMOVE.L D0,FP2⓪(FSUB.L #$80000000,FP2⓪(FMOVE.D FP2,(A0)⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft⓪(MOVE.L D0,D1⓪(MOVE.W #$0102,D0 ;Exponent 32⓪(TST.L D1⓪(BEQ ZERO⓪(BMI Large ;ist linksbündig⓪"POS SUBQ.W #8,D0 ;linksbündig machen⓪(ADD.L D1,D1⓪(BPL POS⓪"Large SWAP D0⓪(SWAP D1⓪(MOVE.W D1,D0⓪(CLR.W D1⓪(MOVE.L D0,(A0)+⓪(MOVE.L D1,(A0)⓪(RTS⓪"!ZERO CLR.L (A0)+⓪(CLR.L (A0)⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(; Da FMOVE immer mit Vorzeichen geschieht, muß der Wert gewandelt werden⓪(ADDI.L #$80000000,D0⓪(; FMOVE.L D0,FP2 ; kein Runtime-Fehler möglich⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(MOVE.W #$4100,fpcmd⓪(MOVE.W fpstat,D1⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L D0,fpop⓪(TST.W fpstat⓪(; FSUB.L #$80000000,FP2⓪(MOVE.W #$4128,fpcmd⓪ DoDl2 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl2⓪(MOVE.L #$80000000,fpop⓪(TST.W fpstat⓪(; FMOVE.D FP2,(A0)⓪(MOVE.W #$7500,fpcmd⓪ DoDl3 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl3⓪(MOVE.L fpop,(A0)+⓪(TST.W fpstat⓪(MOVE.L fpop,(A0)⓪(TST.W fpstat⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L (A0)+⓪(CLR.L (A0)⓪ *)⓪$END⓪"END @LC2D;⓪ ⓪ PROCEDURE @LI2D; (* LI(D0.L) -> LR(A0) /D1,FP2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE.L D0,FP2 ; kein Runtime-Fehler möglich⓪(FMOVE.D FP2,(A0)⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft MOVE.L D0,D1⓪(MOVE.W #$0102,D0 ;Exponent 32⓪(TST.L D1⓪(BEQ ZERO⓪(SMI -(A7) ;Vorz. merken⓪(BPL POS⓪(NEG.L D1⓪(BMI noadj⓪"POS SUBQ.W #8,D0 ;linksbündig machen⓪(ADD.L D1,D1⓪(BPL POS⓪"noadj TST.B (A7)+⓪(BEQ notNeg⓪(TST.W D0 ;Exp.⓪(BEQ notNeg⓪(BSET #0,D0 ;Vorzeichen auf Minus⓪!notNeg SWAP D0⓪(SWAP D1⓪(MOVE.W D1,D0⓪(CLR.W D1⓪(MOVE.L D0,(A0)+⓪(MOVE.L D1,(A0)⓪(RTS⓪"!ZERO CLR.L (A0)+⓪(CLR.L (A0)⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(; FMOVE.L D0,FP2 ; kein Runtime-Fehler möglich⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(MOVE.W #$4100,fpcmd⓪(MOVE.W fpstat,D1⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L D0,fpop⓪(TST.W fpstat⓪(; FMOVE.D FP2,(A0)⓪(MOVE.W #$7500,fpcmd⓪ DoDl3 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl3⓪(MOVE.L fpop,(A0)+⓪(TST.W fpstat⓪(MOVE.L fpop,(A0)⓪(TST.W fpstat⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L (A0)+⓪(CLR.L (A0)⓪ *)⓪$END⓪"END @LI2D;⓪ ⓪ ⓪ PROCEDURE @S2LC; (* SR(D0.L) -> LC(D0.L) *)⓪ (*⓪#d0 (ffp) -> d0 (unsigned)⓪#FP2, d1 is destroyed⓪ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FINTRZ.S D0,FP2⓪(FADD.L #$80000000,FP2⓪(FMOVE.L FP2,D0 ; extrahiert immer mit Vorzeichen!⓪(SUBI.L #$80000000,D0⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft tst.l d0⓪(beq.s fpirtn ; return if zero⓪(move.b d0,d1 ; save sign & exponent⓪(bpl.s over ; branch if minus value⓪(clr.b d0 ; clear for shift⓪(sub.b #$c1,d1 ; exponent -1 to binary (subtract sign bit too)⓪(blt.s fpirt0 ; return zero for fraction⓪(sub.b #31,d1 ; overflow ?⓪(bge.s over2 ; branch if too large⓪(neg.b d1 ; adjust for shift⓪(lsr.l d1,d0 ; finalize integer⓪ fpirtn rts⓪ ; negative or positive overflow⓪ over2 beq fpirtn ; no shifts needed⓪ over LINK A5,#0⓪(TRAP #6⓪(DC.W -6-$4000 ; Out of range⓪(UNLK A5⓪ fpirt0 moveq.l #0,d0 ; return zero⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(; FINTRZ.S D0,FP2⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(MOVE.W #$4503,fpcmd⓪(MOVE.W fpstat,D1⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L D0,fpop⓪(TST.W fpstat⓪(; FADD.L #$80000000,FP2⓪(MOVE.W #$4122,fpcmd⓪ DoDl2 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl2⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L #$80000000,fpop⓪(TST.W fpstat⓪(; FMOVE.L FP2,D0 ; extrahiert immer mit Vorzeichen!⓪(MOVE.W #$6100,fpcmd⓪ DoDl3 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl3⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L fpop,D0⓪(SUBI.L #$80000000,D0⓪(CMPI.W #$0802,fpstat⓪(BNE error⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L D0⓪ *)⓪$END⓪"END @S2LC;⓪ ⓪ PROCEDURE @S2LI; (* SR(D0.L) -> LI(D0.L) *)⓪ (*⓪#d0 (ffp) -> d0 (signed)⓪#FP2, d1 is destroyed⓪ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FINTRZ.S D0,FP2⓪(FMOVE.L FP2,D0 ; extrahiert immer mit Vorzeichen!⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft tst.l d0⓪(beq.s fpirtn ; return if zero⓪(move.b d0,d1 ; save sign & exponent⓪(bpl.s fpimi ; branch if minus value⓪(clr.b d0 ; clear for shift⓪(sub.b #$c1,d1 ; exponent -1 to binary (subtract sign bit too)⓪(blt.s fpirt0 ; return zero for fraction⓪(sub.b #31,d1 ; overflow ?⓪(bge.s fpiovp ; branch if too large⓪(neg.b d1 ; adjust for shift⓪(lsr.l d1,d0 ; finalize integer⓪ fpirtn rts⓪ ; positive overflow⓪ fpiovp LINK A5,#0⓪(TRAP #6⓪(DC.W -6-$4000 ; Out of range⓪(UNLK A5⓪ ; fraction only returns zero⓪ fpirt0 moveq.l #0,d0 ; return zero⓪(rts⓪ ; input is a minus integer⓪ fpimi clr.b d0 ; clear for clean shift⓪(sub.b #$41,d1 ; exponent - 1 to binary⓪(blt.s fpirt0 ; return zero for fraction⓪(sub.b #31,d1 ; overflow ?⓪(bge.s fpichm ; branch possible minus overflow⓪(neg.b d1 ; adjust for shift count⓪(lsr.l d1,d0 ; shift to proper magnitude⓪(neg.l d0 ; to minus now⓪(rts⓪ ; check for maximum minus number or minus overflow⓪ fpichm bne.s fpiovm ; branch minus overflow⓪(neg.l d0 ; attempt convert to negative⓪(tst.l d0 ; clear overflow bit⓪(bmi.s fpirtn ; return if maximum negative integer⓪ fpiovm LINK A5,#0⓪(TRAP #6⓪(DC.W -6-$4000 ; Out of range⓪(UNLK A5⓪(MOVEQ #0,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(; FINTRZ.D D0,FP2⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(MOVE.W #$4503,fpcmd⓪(MOVE.W fpstat,D1⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L D0,fpop⓪(TST.W fpstat⓪(; FMOVE.L FP2,D0 ; extrahiert immer mit Vorzeichen!⓪(MOVE.W #$6100,fpcmd⓪ DoDl3 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl3⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L fpop,D0⓪(CMPI #$0802,fpstat⓪(BNE error⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L D0⓪ *)⓪$END⓪"END @S2LI;⓪ ⓪ ⓪ PROCEDURE @D2LI; (* LR(A0) -> LI(D0.L) /FP2,D1/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FINTRZ.D (A0),FP2⓪(FMOVE.L FP2,D0 ; extrahiert immer mit Vorzeichen!⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft TST.W (A0)⓪(BEQ ZERO⓪(BCLR #0,1(A0)⓪#ZERO SNE -(A7) ; $FF auf Stack -> op war neg.⓪(JSR @D2LC⓪(TST.L D0⓪(BMI err⓪(TST.B (A7)+⓪(BEQ X⓪(NEG.L D0⓪&X RTS⓪"⓪"wasMinInt⓪(TST.B (A7)+ ; negieren?⓪(BEQ err2 ; nein, dann ist $80000000 zu groß⓪(ADDQ.L #1,D0⓪(RTS⓪"⓪"!ERR SUBQ.L #1,D0⓪(BPL wasMinInt ; $80000000 ist noch als Neg. Wert erlaubt!⓪(ADDQ.L #2,A7⓪#err2 LINK A5,#0⓪(TRAP #6⓪(DC.W -6-$4000 ; Out of range⓪(UNLK A5⓪(CLR.L D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(; FINTRZ.D (A0),FP2⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(MOVE.W #$5503,fpcmd⓪(MOVE.W fpstat,D1⓪(SUBQ.B #8,D1⓪(BNE error⓪(MOVE.L (A0)+,fpop⓪(TST.W fpstat⓪(MOVE.L (A0),fpop⓪(TST.W fpstat⓪(; FMOVE.L FP2,D0 ; extrahiert immer mit Vorzeichen!⓪(MOVE.W #$6100,fpcmd⓪ DoDl3 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl3⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L fpop,D0⓪(CMPI.W #$0802,fpstat⓪(BNE error⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L D0⓪ *)⓪$END⓪"END @D2LI;⓪ ⓪ ⓪ PROCEDURE @D2LC; (* LR(A0) -> LC(D0.L) /FP2,D1,D2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FINTRZ.D (A0),FP2⓪(FADD.L #$80000000,FP2⓪(FMOVE.L FP2,D0 ; extrahiert immer mit Vorzeichen!⓪(SUBI.L #$80000000,D0⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft⓪(MOVEM.L D3-D4,-(A7)⓪(MOVE.L (A0)+,D1⓪(MOVE.L (A0),D0⓪(SWAP D1⓪(BTST #0,D1⓪(BNE nega ;Zahl ist negativ -> Fehler⓪(ASR.W #3,D1⓪(MOVE.W #32,D4⓪(SUB.W D1,D4⓪(BLT Err ;Exponent war > 32: 0.FFF.. * 2^32 ist MaxLCard⓪(CMP.W #32,D4⓪(BCC ZERO ;Exponent war <= 0⓪(MOVE.L D1,D2⓪(SWAP D0⓪(MOVE.W D0,D2⓪(LSR.L D4,D2⓪(BRA X⓪"!ERR⓪"!NEGA MOVEM.L (A7)+,D3-D4⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -6-$4000 ; Out of range⓪(UNLK A5⓪(CLR.L D0⓪(RTS⓪ ⓪"!ZERO CLR.L D2⓪"!X MOVE.L D2,D0⓪(MOVEM.L (A7)+,D3-D4⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(; FINTRZ.D (A0),FP2⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(MOVE.W #$5503,fpcmd⓪(MOVE.W fpstat,D1⓪(SUBQ.B #8,D1⓪(BNE error⓪(MOVE.L (A0)+,fpop⓪(TST.W fpstat⓪(MOVE.L (A0),fpop⓪(TST.W fpstat⓪(; FADD.L #$80000000,FP2⓪(MOVE.W #$4122,fpcmd⓪ DoDl2 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl2⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L #$80000000,fpop⓪(TST.W fpstat⓪(; FMOVE.L FP2,D0 ; extrahiert immer mit Vorzeichen!⓪(MOVE.W #$6100,fpcmd⓪ DoDl3 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl3⓪(SUBQ.B #4,D1⓪(BNE error⓪(MOVE.L fpop,D0⓪(SUBI.L #$80000000,D0⓪(CMPI.W #$0802,fpstat⓪(BNE error⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L D0⓪ *)⓪$END⓪"END @D2LC;⓪ ⓪ ⓪ (********* Real-Vergleiche *********)⓪ ⓪ (*$? A68881:⓪ PROCEDURE DoComp;⓪ (* A0: ^right, A1: ^left, Ergebnis als BOOLEAN in D0, FP2 zerstört *)⓪ BEGIN⓪"ASSEMBLER⓪ DoDl0 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ DoDl0⓪(MOVE.W #$5500,fpcmd ;FMOVE (A1),FP2⓪(MOVE.W fpstat,D0⓪(SUBQ.B #8,D0⓪(BNE DoCError⓪(MOVE.L (A1)+,fpop⓪(TST.W fpstat⓪(MOVE.L (A1),fpop⓪(TST.W fpstat⓪(MOVE.W #$5538,fpcmd ;FCMP (A0),FP2⓪ DoCl2 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ DoCl2⓪(SUBQ.B #8,D0⓪(BNE DoCError⓪(MOVE.L (A0)+,fpop⓪(TST.W fpstat⓪(MOVE.L (A0),fpop⓪(TST.W fpstat⓪(MOVE.W D1,fpcond ;FBcc⓪(MOVE.W fpstat,D0 ;Bool-Wert abholen⓪(ANDI #1,D0⓪(RTS⓪ DoCError LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR D0⓪"END;⓪ END DoComp;⓪ *)⓪ ⓪ PROCEDURE @LREQ;⓪"BEGIN⓪$ASSEMBLER⓪(; Bei IEEE sind +0.0 und -0.0 nicht identisch -> Pech⓪(MOVE.L (A0)+,D0⓪(CMP.L (A1)+,D0⓪(BNE NE⓪(MOVE.L (A0),D0⓪(CMP.L (A1),D0⓪(BNE NE⓪(MOVEQ #true,D0⓪(RTS⓪$!NE CLR.W D0⓪$END⓪"END @LREQ;⓪ ⓪ PROCEDURE @LRNE;⓪"BEGIN⓪$ASSEMBLER⓪(; Bei IEEE sind +0.0 und -0.0 nicht identisch -> Pech⓪(MOVE.L (A0)+,D0⓪(CMP.L (A1)+,D0⓪(BNE NE⓪(MOVE.L (A0),D0⓪(CMP.L (A1),D0⓪(BNE NE⓪(CLR.W D0⓪(RTS⓪$!NE MOVEQ #true,D0⓪$END⓪"END @LRNE;⓪ ⓪ ⓪ PROCEDURE @LRLE;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE (A1),FP2⓪(FCMP (A0),FP2⓪(FSLE D0⓪(ANDI #1,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEQ #$15,D1 ;Conditional LE⓪(JMP DoComp⓪ *)⓪ (*$? SoftReal:⓪ soft MOVEM.L D3/D4,-(A7)⓪(MOVEQ #16,D4⓪(MOVE.L (A0)+,D1 ;rechter Operand⓪(BEQ zer2⓪(MOVE.L (A0),D0⓪(MOVE.L (A1)+,D3 ;linker Operand⓪(BEQ zer1⓪(MOVE.L (A1),D2⓪(BTST D4,D3⓪(BNE neg1 ;Op1 negativ⓪(BTST D4,D1⓪(BNE neg2 ;Op2 negativ⓪(CMP.L D1,D3 ;beide Operanden positiv⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D0,D2⓪(BLS neg3⓪(BRA neg2⓪!neg1 BTST D4,D1⓪(BEQ neg3 ;Op1 negativ, Op2 positiv⓪(CMP.L D3,D1⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D2,D0⓪(BLS neg3⓪!neg2 CLR.W D0 ;Op1 positiv, Op2 negativ⓪(MOVEM.L (A7)+,D3/D4⓪(RTS⓪!zer2 MOVE.L (A1),D3⓪(BEQ neg3 ;Op1 = Op2 = 0⓪(BTST D4,D3⓪(BNE neg3 ;Op2 = 0; Op1 < 0⓪(BRA neg2⓪!zer1 BTST D4,D1 ;Op1 Null, Op2 # 0: ist Op2 < 0?⓪(BNE neg2 ; ja⓪!neg3 MOVEM.L (A7)+,D3/D4⓪(MOVEQ #TRUE,D0⓪ *)⓪$END⓪"END @LRLE;⓪ ⓪ PROCEDURE @LRGE;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE (A1),FP2⓪(FCMP (A0),FP2⓪(FSGE D0⓪(ANDI #1,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEQ #$13,D1 ;Conditional GE⓪(JMP DoComp⓪ *)⓪ (*$? SoftReal:⓪ soft MOVEM.L D3/D4,-(A7)⓪(MOVEQ #16,D4⓪(MOVE.L (A0)+,D1 ;rechter Operand⓪(BEQ zer2⓪(MOVE.L (A0),D0⓪(MOVE.L (A1)+,D3 ;linker Operand⓪(BEQ zer1⓪(MOVE.L (A1),D2⓪(BTST D4,D3⓪(BNE neg1 ;Op1 negativ⓪(BTST D4,D1⓪(BNE neg2 ;Op2 negativ⓪(CMP.L D1,D3 ;beide Operanden positiv⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D0,D2⓪(BCS neg3⓪(BRA neg2⓪!neg1 BTST D4,D1⓪(BEQ neg3 ;Op1 negativ, Op2 positiv⓪(CMP.L D3,D1⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D2,D0⓪(BCS neg3⓪!neg2 MOVEQ #true,D0 ;Op1 positiv, Op2 negativ⓪(MOVEM.L (A7)+,D3/D4⓪(RTS⓪!zer2 ;Op2 Null, Op1 <= 0 ?⓪(MOVE.L (A1),D3⓪(BEQ neg2 ;beide Null⓪(BTST D4,D3⓪(BNE neg3 ;Op2 = 0, Op1 < 0⓪(BRA neg2 ;Op2 = 0, Op1 > 0⓪!zer1 BTST D4,D1 ;Op1 = 0, Op2 # 0: ist Op2 > 0?⓪(BNE neg2 ; nein⓪!neg3 CLR.W D0 ;Op1 negativ, Op2 positiv⓪(MOVEM.L (A7)+,D3/D4⓪ *)⓪$END⓪"END @LRGE;⓪ ⓪ PROCEDURE @LRLT;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE (A1),FP2⓪(FCMP (A0),FP2⓪(FSLT D0⓪(ANDI #1,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEQ #$14,D1 ;Conditional LT⓪(JMP DoComp⓪ *)⓪ (*$? SoftReal:⓪ soft MOVEM.L D3/D4,-(A7)⓪(MOVEQ #16,D4⓪(MOVE.L (A0)+,D1 ;rechter Operand⓪(BEQ zer2⓪(MOVE.L (A0),D0⓪(MOVE.L (A1)+,D3 ;linker Operand⓪(BEQ zer1⓪(MOVE.L (A1),D2⓪(BTST D4,D3⓪(BNE neg1 ;Op1 negativ⓪(BTST D4,D1⓪(BNE neg2 ;Op2 negativ⓪(CMP.L D1,D3 ;beide Operanden positiv⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D0,D2⓪(BCS neg3⓪(BRA neg2⓪!neg1 BTST D4,D1⓪(BEQ neg3 ;Op1 negativ, Op2 positiv⓪(CMP.L D3,D1⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D2,D0⓪(BCS neg3⓪!neg2 CLR.W D0 ;Op1 positiv, Op2 negativ⓪(MOVEM.L (A7)+,D3/D4⓪(RTS⓪!zer2 ;Op2 Null, Op1 <= 0 ?⓪(MOVE.L (A1),D3⓪(BEQ neg2 ;beide Null⓪(BTST D4,D3⓪(BNE neg3 ;Op2 = 0, Op1 < 0⓪(BRA neg2 ;Op2 = 0, Op1 > 0⓪!zer1 BTST D4,D1 ;Op1 = 0, Op2 # 0: ist Op2 > 0?⓪(BNE neg2 ; nein⓪!neg3 MOVEQ #TRUE,D0 ;Op1 negativ, Op2 positiv⓪(MOVEM.L (A7)+,D3/D4⓪ *)⓪$END⓪"END @LRLT;⓪ ⓪ PROCEDURE @LRGT;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE (A1),FP2⓪(FCMP (A0),FP2⓪(FSGT D0⓪(ANDI #1,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEQ #$12,D1 ;Conditional GT⓪(JMP DoComp⓪ *)⓪ (*$? SoftReal:⓪ soft MOVEM.L D3/D4,-(A7)⓪(MOVEQ #16,D4⓪(MOVE.L (A0)+,D1 ;rechter Operand⓪(BEQ zer2⓪(MOVE.L (A0),D0⓪(MOVE.L (A1)+,D3 ;linker Operand⓪(BEQ zer1⓪(MOVE.L (A1),D2⓪(BTST D4,D3⓪(BNE neg1 ;Op1 negativ⓪(BTST D4,D1⓪(BNE neg2 ;Op2 negativ⓪(CMP.L D1,D3 ;beide Operanden positiv⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D0,D2⓪(BLS neg3⓪(BRA neg2⓪!neg1 BTST D4,D1⓪(BEQ neg3 ;Op1 negativ, Op2 positiv⓪(CMP.L D3,D1⓪(BLT neg3⓪(BGT neg2⓪(CMP.L D2,D0⓪(BLS neg3⓪!neg2 MOVEQ #true,D0 ;Op1 positiv, Op2 negativ⓪(MOVEM.L (A7)+,D3/D4⓪(RTS⓪!zer2 ;Op2 Null, Op1 <= 0 ?⓪(MOVE.L (A1),D3⓪(BEQ neg3 ;beide Null⓪(BTST D4,D3⓪(BNE neg3 ;Op2 = 0, Op1 < 0⓪(BRA neg2 ;Op2 = 0, Op1 > 0⓪!zer1 BTST D4,D1 ;Op1 = 0, Op2 # 0: ist Op2 > 0?⓪(BNE neg2 ; nein⓪!neg3 CLR.W D0 ;Op1 negativ, Op2 positiv⓪(MOVEM.L (A7)+,D3/D4⓪ *)⓪$END⓪"END @LRGT;⓪ ⓪ ⓪ (********* LongReal-Arithmetik *********)⓪ ⓪ PROCEDURE @LNEG;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BPL ieee⓪ *)⓪ (*$? SoftReal:⓪(TST.W (A0)⓪(BEQ ZERO⓪(BCHG #0,1(A0)⓪#ZERO RTS⓪ *)⓪ (*$? IEEEReal:⓪#ieee BCHG #7,(A0)⓪ *)⓪$END⓪"END @LNEG;⓪ ⓪ PROCEDURE @LABS;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BPL ieee⓪ *)⓪ (*$? SoftReal:⓪(TST.W (A0)⓪(BEQ ZERO⓪(BCLR #0,1(A0)⓪#ZERO RTS⓪ *)⓪ (*$? IEEEReal:⓪#ieee BCLR #7,(A0)⓪ *)⓪$END⓪"END @LABS;⓪ ⓪ ⓪ (*$? A68881:⓪ PROCEDURE LongDouble;⓪"(* Erwartet in Register D1 eine Co-Instruction,⓪#* in A0: ^right, A1: ^left/ziel *)⓪"BEGIN⓪$ASSEMBLER⓪ DoDl0 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ DoDl0⓪(MOVE.W #$5400,fpcmd ; FMOVE.D (A1),FP0⓪(MOVE.W fpstat,D0⓪(SUBQ.B #8,D0⓪(BNE DoDErr⓪(MOVE.L (A1)+,fpop⓪(TST.W fpstat⓪(MOVE.L (A1),fpop⓪(TST.W fpstat⓪(MOVE.W D1,fpcmd ; Fxxxx.D (A0),FP0⓪(MOVE.W fpstat,D0⓪(SUBQ.B #8,D0⓪(BNE DoDErr⓪(MOVE.L (A0)+,fpop⓪(TST.W fpstat⓪(MOVE.L (A0),fpop⓪(TST.W fpstat⓪(MOVE.W #$7400,fpcmd ; FMOVE.D FP0,(A1)⓪ !DoDl3 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ DoDl3⓪(SUBQ.B #8,D0⓪(BNE DoDErr⓪ !GoBack MOVE.L fpop,-4(A1)⓪(TST.W fpstat⓪(MOVE.L fpop,(A1)⓪(CMPI.W #$0802,fpstat⓪(BNE DoDErr⓪(RTS⓪ DoDErr CLR.L -4(A1) ; RETURN 0.0⓪(CLR.L (A1)⓪(LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪$END;⓪"END LongDouble;⓪ *)⓪ ⓪ (*$? A68881:⓪ PROCEDURE ShortDouble;⓪"(* Erwartet auf dem A7-Stack eine Co-Instruction,⓪#* in D0: ^right, D1: ^left/ziel *)⓪"BEGIN⓪$ASSEMBLER⓪ DoDl0 MOVE.W fpstat,D2⓪(TST.B D2⓪(BEQ DoDl0⓪(MOVE.W #$4400,fpcmd ; FMOVE.S D1,FP0⓪(MOVE.W fpstat,D2⓪(SUBQ.B #4,D2⓪(BNE DoDErr2⓪(MOVE.L D1,fpop⓪(TST.W fpstat⓪(MOVE.W (A7)+,fpcmd ; Fxxxx.S D0,FP0⓪ !DoDl2 MOVE.W fpstat,D2⓪(TST.B D2⓪(BEQ DoDl2⓪(MOVE.L D0,fpop⓪(TST.W fpstat⓪(MOVE.W #$6400,fpcmd ; FMOVE.S FP0,D1⓪ !DoDl3 MOVE.W fpstat,D2⓪(TST.B D2⓪(BEQ DoDl3⓪(SUBQ.B #4,D2⓪(BNE DoDErr⓪ !GoBack MOVE.L fpop,D1⓪(CMPI.W #$0802,fpstat⓪(BNE DoDErr⓪(RTS⓪ DoDErr2 ADDQ.L #2,A7⓪ DoDErr LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L D1⓪$END;⓪"END ShortDouble;⓪ *)⓪ ⓪ ⓪ PROCEDURE @LMUL;⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪+TST fpu⓪+BEQ external⓪+BMI soft⓪ *)⓪ (*$? M68881:⓪+FMOVE.D (A1),FP0⓪+FMUL.D (A0),FP0⓪+FMOVE.D FP0,(A1)⓪+RTS⓪ *)⓪ (*$? A68881:⓪ external⓪+MOVE.W #$5423,D1⓪+JMP LongDouble⓪ *)⓪ (*$? SoftReal:⓪ soft MOVEM.L D3-D7,-(A7)⓪+⓪+; linker Wert, Ziel⓪+MOVE.L A1,A2⓪+MOVE.W (A1)+,D0⓪+MOVE.W (A1)+,D1⓪+MOVE.W (A1)+,D2⓪+MOVE.W (A1),D3⓪+; rechter Wert⓪+MOVE.W (A0)+,D4⓪+MOVE.W (A0)+,D5⓪+MOVE.W (A0)+,D6⓪+MOVE.W (A0),D7⓪+⓪+TST.W D0 ;Op1 = 0 ?⓪+BEQ.L ZERO⓪+TST.W D4 ;Op2 = 0 ?⓪+BEQ.L ZERO⓪+ADD.W D0,D4 ;vorl. Exponent; neues Sign in bit0⓪+BVS.L range ;Ueber/Unterlauf⓪+MOVE.W D4,-(A7)⓪+MOVE.W D3,D4⓪+MULU D7,D4⓪+CLR.W D4⓪+SWAP D4⓪+CLR.W D5⓪+MOVE.W D3,D0⓪+MULU D6,D0⓪+ADD.L D0,D4⓪+BCC L0⓪+ADDQ.W #1,D5⓪"!L0 MOVE.W D2,D0⓪+MULU D7,D0⓪+ADD.L D0,D4⓪+BCC L1⓪+ADDQ.W #1,D5⓪"!L1 MOVE.W D5,D4⓪+SWAP D4⓪+CLR.W D5⓪+MULU D1,D7⓪+ADD.L D7,D4⓪+BCC L2⓪+ADDQ.W #1,D5⓪"!L2 MOVE.W -4(A0),D7⓪+MOVE.W D2,D0⓪+MULU D6,D0⓪+ADD.L D0,D4⓪+BCC L3⓪+ADDQ.W #1,D5⓪"!L3 MULU D7,D3⓪+ADD.L D3,D4⓪+BCC L4⓪+ADDQ.W #1,D5⓪"!L4 MOVE.W D4,D3⓪+MOVE.W D5,D4⓪+SWAP D4⓪+CLR.W D5⓪+MULU D7,D2⓪+ADD.L D2,D4⓪+BCC L5⓪+ADDQ.W #1,D5⓪"!L5 MULU D1,D6⓪+ADD.L D6,D4⓪+BCC L6⓪+ADDQ.W #1,D5⓪"!L6 MOVE.W D4,D6⓪+MOVE.W D5,D4⓪+SWAP D4⓪+MULU D7,D1⓪+⓪+MOVE.W (A7)+,D7⓪+ADD.L D1,D4⓪+BMI ISADJ⓪+ADD.W D3,D3⓪+ADDX.W D6,D6⓪+ADDX.L D4,D4⓪+SUBQ.W #8,D7⓪+BVS ZERO⓪"!ISADJ TST.W D3⓪+BPL NORND⓪+ADDQ.W #1,D6⓪+BCC NORND⓪+ADDQ.L #1,D4⓪+BCC NORND⓪+ADDQ.W #8,D7⓪+BSET #31,D4⓪"!NORND BSET #1,D7 ;markiere als # 0⓪+BCLR #2,D7 ;loesche Schutzbit⓪+MOVE.W D7,(A2)+⓪+MOVE.L D4,(A2)+⓪+MOVE.W D6,(A2)⓪+MOVEM.L (A7)+,D3-D7⓪+RTS⓪+⓪"range BPL zero⓪+;Summe der Exponenten war so gross,⓪+;dass sie ins negative ueberlief⓪+⓪"ovfl MOVEM.L (A7)+,D3-D7⓪+LINK A5,#0⓪+TRAP #6⓪+DC.W -7-$4000 ;overflow⓪+UNLK A5⓪+CLR.L (A2)+⓪+CLR.L (A2)⓪+RTS⓪ ⓪"zero CLR.L (A2)+⓪+CLR.L (A2)⓪+MOVEM.L (A7)+,D3-D7⓪ *)⓪"END⓪ END @LMUL;⓪ ⓪ ⓪ PROCEDURE @LDIV;⓪ BEGIN⓪"ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE.D (A1),FP0⓪(FDIV.D (A0),FP0⓪(FMOVE.D FP0,(A1)⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVE.W #$5420,D1⓪(JMP LongDouble⓪ *)⓪ (*$? SoftReal:⓪ soft MOVEM.L D3-D7,-(A7)⓪(⓪(; rechter Wert⓪(MOVE.W (A0)+,D1⓪(MOVE.L (A0)+,D4⓪(MOVE.W (A0),D5⓪(⓪(; linker Wert, Ziel⓪(MOVE.L A1,A2⓪(MOVE.W (A1)+,D0⓪(MOVE.L (A1)+,D2⓪(MOVE.W (A1),D3⓪(⓪(TST.W D1⓪(BEQ.L DIVBY0⓪(TST.W D0⓪(BEQ.L ZERO1⓪(BCLR #1,D1 ; !TT 01.04.88⓪(SUB.W D1,D0 ;vorl. Exponent und Sign in D0⓪(BVS.L range ;Ueber/Unterlauf⓪(CLR.L D7⓪(MOVEQ #49,D1⓪(BRA L1⓪ !L0 ADD.L D7,D7⓪(ADDX.L D6,D6⓪(ADD.W D3,D3⓪(ADDX.L D2,D2⓪(BCS ONEBIT⓪ !L1 CMP.L D2,D4⓪(BHI ZERBIT⓪(BNE ONEBIT⓪(CMP.W D3,D5⓪(BHI ZERBIT⓪ !ONEBIT SUB.W D5,D3⓪(SUBX.L D4,D2⓪(ADDQ.B #1,D7⓪ !ZERBIT DBF D1,L0⓪(BTST #17,D6⓪(BEQ LESS05⓪(LSR.L #1,D6⓪(ROXR.L #1,D7⓪(ADDQ.W #8,D0⓪(BVS ovfl⓪ !LESS05 LSR.L #1,D6⓪(ROXR.L #1,D7⓪(BCC NORND⓪(ADDQ.L #1,D7⓪(BCC NORND⓪(ADDQ.W #1,D6⓪(BCC NORND⓪(ROXR.W #1,D6⓪(ADDQ.W #8,D0⓪(BVS ovfl⓪ noRnd BSET #1,D0⓪(BCLR #2,D0⓪(MOVE.W D0,(A2)+⓪(MOVE.W D6,(A2)+⓪(MOVE.L D7,(A2)⓪(MOVEM.L (A7)+,D3-D7⓪(RTS⓪(⓪ range BMI ovfl ;Differenz der Exponenten war so gross,⓪=;dass sie ins negative ueberlief⓪ zero1 CLR.L (A2)+⓪(CLR.L (A2)⓪(MOVEM.L (A7)+,D3-D7⓪(RTS⓪(⓪ ovfl MOVEM.L (A7)+,D3-D7⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -7-$4000 ;overflow⓪(BRA errend⓪(⓪ DivBy0 MOVEM.L (A7)+,D3-D7⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -5-$4000⓪ errend: UNLK A5⓪(CLR.L (A2)+⓪(CLR.L (A2)⓪ ⓪ *)⓪"END⓪ END @LDIV;⓪ ⓪ PROCEDURE LsoftADD;⓪"BEGIN⓪$ASSEMBLER⓪); MOVEM.L D3-D7,-(A7) dies wird schon beim Aufrufer gemacht!⓪+⓪+MOVE.L A1,A2⓪+; rechter Wert⓪); MOVE.W (A0)+,D4 dies wird schon beim Aufrufer gemacht!⓪+MOVE.W D4,-(A7) ; wird später noch gebraucht⓪+ANDI #$FFFE,D4⓪+BEQ.L RETN0 ;rechter Wert ist Null -> fertig⓪+MOVE.L (A0)+,D5⓪+MOVE.W (A0),D7⓪+; linker Wert, Ziel⓪+MOVE.W (A1)+,D0⓪+ANDI #$FFFE,D0⓪+BEQ.L RETN2 ;ein Argument ist 0⓪+MOVE.L (A1)+,D1⓪+MOVE.W (A1),D3⓪+⓪+CLR.W D6⓪+CMP.W D0,D4⓪+BLT PASST⓪+BNE TAUSCH⓪+CMP.L D1,D5⓪+BCS.L PASST1⓪+BNE TAUSCH⓪+CMP.W D3,D7⓪+BLS.L PASST1⓪"!TAUSCH EXG D0,D4⓪+EXG D1,D5⓪+EXG D3,D7⓪+MOVE.W (A2),D2⓪+MOVE.W (A7),(A2)⓪+MOVE.W D2,(A7)⓪"⓪"!PASST SUB.W D4,D0 ;Exp.differenz immer positiv!⓪+LSR #3,D0⓪+BEQ.L PASST1⓪+CMP.W #16,D0⓪+BEQ S16⓪+BHI SGT16⓪+SWAP D7⓪+MOVE.W D5,D7⓪+SWAP D7⓪+LSR.L D0,D5⓪+LSR.L D0,D7⓪+BRA.L DONE⓪"!S16 ADD.W D7,D7⓪+MOVE.W D5,D7⓪+CLR.W D5⓪+SWAP D5⓪+BRA DONE⓪"!SGT16 CMP.W #32,D0⓪+BEQ S32⓪+BHI SGT32⓪+SUB.W #16,D0⓪+LSR.L D0,D5⓪+MOVE.W D5,D7⓪+CLR.W D5⓪+SWAP D5⓪+BRA DONE⓪"!S32 ADD.W D5,D5⓪+SWAP D5⓪+MOVE.W D5,D7⓪+CLR.L D5⓪+BRA DONE⓪"!S48 CLR.L D5⓪+CLR.W D7⓪+MOVEQ #$FF,D6⓪+BRA PASST1⓪"!SGT32 CMP.W #48,D0⓪+BEQ S48⓪+BHI.L RETN1⓪+SUB.W #32,D0⓪+SWAP D5⓪+MOVE.W D5,D7⓪+CLR.L D5⓪+LSR.W D0,D7⓪"!DONE ROXR.W #1,D6⓪"!PASST1 MOVE.W (A2),D2 ;Vorzeichen beider Operanden gleich?⓪+MOVE.W (A7),D0⓪+ADD.W D2,D0⓪+BTST #0,D0⓪+BNE SUBTR⓪+ADD.W D7,D3⓪+ADDX.L D5,D1⓪+BCC NOFL⓪+ROXR.L #1,D1⓪+ROXR.W #1,D3⓪+BCC INCEX⓪+ADDQ.W #1,D3⓪+BCC INCEX⓪+ADDQ.L #1,D1⓪"!INCEX ADDQ.W #8,D2 ;D2 ist Exp. der betr.mäßig größeren Zahl⓪+BVS.L OVFL⓪"!FERTIG MOVE.W D2,(A2)+⓪+MOVE.L D1,(A2)+⓪+MOVE.W D3,(A2)⓪"!RETN0 ADDQ.L #2,A7⓪+MOVEM.L (A7)+,D3-D7⓪+RTS⓪+⓪"!NOFL TST.W D6⓪+BPL FERTIG⓪+ADDQ.W #1,D3⓪+BCC FERTIG⓪+ADDQ.L #1,D1⓪+BCC FERTIG⓪+ROXR.L #1,D1⓪+BRA INCEX⓪"⓪"!SUBTR ADD.W D6,D6⓪+SCS D6⓪+SUBX.W D7,D3⓪+SUBX.L D5,D1⓪+TST.L D1⓪+BMI FERTIG⓪+SUBQ.W #8,D2⓪+ADD.W D6,D6⓪+ADDX.W D3,D3⓪+ADDX.L D1,D1⓪+BMI.L fertig⓪+BEQ LGT32 ;Ausloeschung in der Mantisse.. normalisieren⓪+SWAP D1⓪+TST.W D1⓪+BNE LLT16⓪+MOVE.W D3,D1⓪+CLR.W D3⓪+SUB.W #128,D2 ;8 * (16 bit Shift)⓪+BVS zero⓪+TST.L D1⓪+BMI fertig⓪"!L0 SUBQ.W #8,D2⓪+BVS zero⓪+ADD.L D1,D1⓪+BPL L0⓪+BRA fertig⓪"!LLT16 SWAP D1⓪"!L1 SUBQ.W #8,D2⓪+BVS zero⓪+ADD.W D3,D3⓪+ADDX.L D1,D1⓪+BPL L1⓪+BRA fertig⓪"!LGT32 SUB.W #256,D2 ;8 * (32 bit Shift)⓪+BVS zero⓪+MOVE.W D3,D1⓪+BEQ ZERO⓪+BMI L3⓪"!L2 SUBQ.W #8,D2⓪+BVS zero⓪+ADD.W D1,D1⓪+BPL L2⓪"!L3 SWAP D1⓪+CLR.W D3⓪+BRA fertig⓪"!ZERO CLR.L (A2)+⓪+CLR.L (A2)⓪+ADDQ.L #2,A7⓪+MOVEM.L (A7)+,D3-D7⓪+RTS⓪+⓪"!RETN1 ;Exponent stimmt schon⓪+ADDQ.L #2,A2⓪+MOVE.L D1,(A2)+ ;Mantisse muß (bei Ausgang 2 hierher)⓪+MOVE.W D3,(A2) ; noch getauscht werden!⓪+ADDQ.L #2,A7⓪+MOVEM.L (A7)+,D3-D7⓪+RTS⓪+⓪"!RETN2 MOVE.W (A7)+,(A2)+⓪+MOVE.L D5,(A2)+⓪+MOVE.W D7,(A2)+⓪+MOVEM.L (A7)+,D3-D7⓪+RTS⓪+⓪"!OVFL ADDQ.L #2,A7⓪+MOVEM.L (A7)+,D3-D7⓪+LINK A5,#0⓪+TRAP #6⓪+DC.W -7-$4000 ;overflow⓪+UNLK A5⓪+CLR.L (A2)+⓪+CLR.L (A2)⓪$END⓪"END LsoftADD;⓪ ⓪ PROCEDURE @LADD;⓪ BEGIN⓪%ASSEMBLER⓪ (*$? AutoFPU:⓪+TST fpu⓪+BEQ external⓪+BMI soft⓪ *)⓪ (*$? M68881:⓪+FMOVE.D (A1),FP0⓪+FADD.D (A0),FP0⓪+FMOVE.D FP0,(A1)⓪+RTS⓪ *)⓪ (*$? A68881:⓪ external MOVE.W #$5422,D1⓪+JMP LongDouble⓪ *)⓪ (*$? SoftReal:⓪ soft MOVEM.L D3-D7,-(A7)⓪+; rechter Wert⓪+MOVE.W (A0)+,D4⓪+JMP LsoftADD⓪ *)⓪"END⓪ END @LADD;⓪ ⓪ PROCEDURE @LSUB;⓪ BEGIN⓪"ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE.D (A1),FP0⓪(FSUB.D (A0),FP0⓪(FMOVE.D FP0,(A1)⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft MOVEM.L D3-D7,-(A7)⓪(; rechter Wert⓪ ⓪(MOVE.W (A0)+,D4⓪(BEQ N⓪(BCHG #0,D4⓪&N JMP LsoftADD⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVE.W #$5428,D1⓪(JMP LongDouble⓪ *)⓪"END⓪ END @LSUB;⓪ ⓪ ⓪ PROCEDURE @STOL;⓪"(* D0 -> (A0), /D1,FP2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ externl⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE.S D0,FP2⓪(FMOVE.D FP2,(A0)⓪(RTS⓪ *)⓪ (*$? A68881:⓪ externl⓪ DoDl0 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl0⓪(MOVE.W #$4500,fpcmd ; FMOVE.S D0,FP2⓪(MOVE.W fpstat,D1⓪(SUBQ.B #4,D1⓪(BNE DoDErr⓪(MOVE.L D0,fpop⓪(TST.W fpstat⓪(MOVE.W #$7500,fpcmd ; FMOVE.D FP2,(A0)⓪ !DoDl3 MOVE.W fpstat,D1⓪(TST.B D1⓪(BEQ DoDl3⓪(SUBQ.B #8,D1⓪(BNE DoDErr⓪ !GoBack MOVE.L fpop,(A0)+⓪(TST.W fpstat⓪(MOVE.L fpop,(A0)⓪(CMPI.W #$0802,fpstat⓪(BNE DoDErr2⓪(RTS⓪ DoDErr CLR.L (A0)+⓪(CLR.L (A0)⓪ DoDErr2 LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft MOVE.L D0,D1 ; save mantissa⓪(beq.s null ; branch if zero⓪(and.w #$7f,D0 ; mask exponent⓪(sub.w #$40,D0 ; sub bias $40⓪(lsl.w #3,D0 ; shift signed exponent⓪(bset #1,D0 ; set #0 bit⓪(tst.b D1 ; test sign⓪(bmi posit ; skip if positive⓪(bset.l #0,D0 ; insert negative sign⓪ posit swap.w D0 ; swap exponent & sign into high word⓪(clr.b D1 ; clear ffp sign & exponent⓪(swap.w D1 ; get most significand 16 mantissa bits⓪(move.w D1,D0 ; high order long word now ok⓪(clr.w D1 ; remaining 8 mantissa bits in highest byte⓪ null MOVE.L D0,(A0)+⓪(MOVE.L D1,(A0)⓪ *)⓪$END⓪"END @STOL;⓪ ⓪ PROCEDURE @LTOS;⓪ (*⓪#(A0) (atari floating point format) -> D0 (ffp format), /D1,D2,FP2/⓪ ⓪#D1: sign, exp+$1000, 16 bit mantissa⓪#D0: 32 bit mantissa⓪ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ externl⓪(BMI soft⓪ *)⓪ (*$? M68881:⓪(FMOVE.D (A0),FP2⓪(FMOVE.S FP2,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ externl⓪ DoDl0 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ DoDl0⓪(MOVE.W #$5500,fpcmd ; FMOVE.D (A0),FP2⓪(MOVE.W fpstat,D0⓪(SUBQ.B #8,D0⓪(BNE DoDErr⓪(MOVE.L (A0)+,fpop⓪(TST.W fpstat⓪(MOVE.L (A0),fpop⓪ !DoDl3 TST.W fpstat⓪(BMI DoDl3⓪(MOVE.W #$6500,fpcmd ; FMOVE.S FP2,D0⓪ !DoDl5 MOVE.W fpstat,D0⓪(TST.B D0⓪(BEQ DoDl5⓪(SUBQ.B #4,D0⓪(BNE DoDErr⓪ !GoBack MOVE.L fpop,D0⓪(CMPI.W #$0802,fpstat⓪(BNE DoDErr⓪(RTS⓪ !DoDErr LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L D0⓪(RTS⓪ *)⓪ (*$? SoftReal:⓪ soft move.l (A0)+,d1⓪(move.l (A0),d0⓪(swap.w d1 ; get exponent into low word⓪(move.w d1,d2 ; prepare exponent calculation⓪(beq.s null ; branch if exponent is zero⓪(⓪(asr.w #3,d2⓪(add.w #$40,d2 ; add bias⓪(bmi.s null ; still neg.: underflow⓪(cmp.w #$80,d2 ; compare with maximum ffp exponent⓪(bcc.s overfl ; branch if exponent too high⓪(btst #0,d1 ; test sign bit⓪(bne isneg⓪(addi.b #$80,d2⓪"isneg swap.w d0 ; get mantissa bit 16..24⓪(move.w d0,d1 ; now complete mantissa⓪(tst.b d1 ; must we round up ?⓪(bpl.s noround ; skip rounding up⓪(add.l #$100,d1 ; round it up⓪(bcc.s noround ; were there all ones ?⓪(bset.l #31,d1 ; division by two⓪(addq.b #1,d2 ; correct exponent⓪(bvs.s overfl ; exponent overflow⓪ noround move.b d2,d1 ; place sign & exponent⓪(move.l d1,d0⓪(rts⓪ overfl LINK A5,#0⓪(TRAP #6⓪(DC.W -7-$4000 ;overflow⓪(UNLK A5⓪ null MOVEQ #0,D0 ; get a true zero⓪ *)⓪$END⓪"END @LTOS;⓪ ⓪ PROCEDURE @SRLE; (* D1 <= D0? -> D0 /D2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BPL ieee⓪ *)⓪ (*$? SoftReal:⓪(MOVE.B D0,D2⓪(OR.B D1,D2⓪(BMI.S onepos ; mindestens ein Operand positiv: normal⓪(EXG.L D0,D1 ; beide negativ: tauschen⓪!onepos CMP.B D0,D1⓪(BNE.S eval⓪(CMP.L D0,D1⓪#eval SLS D0⓪(ANDI.W #1,D0⓪(RTS⓪ *)⓪ (*$? IEEEReal:⓪#ieee TST.L D0⓪(BPL ie1⓪(TST.L D1⓪(BPL ie1⓪(EXG.L D0,D1⓪$ie1 CMP.L D0,D1⓪(SLE D0⓪(ANDI #1,D0⓪ *)⓪$END⓪"END @SRLE;⓪ ⓪ PROCEDURE @SRGE; (* D1 >= D0? -> D0 /D2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BPL ieee⓪ *)⓪ (*$? SoftReal:⓪(MOVE.B D0,D2⓪(OR.B D1,D2⓪(BMI.S onepos ; mindestens ein Operand positiv: normal⓪(EXG.L D0,D1 ; beide negativ: tauschen⓪!onepos CMP.B D0,D1⓪(BNE.S eval⓪(CMP.L D0,D1⓪#eval SCC D0⓪(ANDI.W #1,D0⓪(RTS⓪ *)⓪ (*$? IEEEReal:⓪#ieee TST.L D0⓪(BPL ie1⓪(TST.L D1⓪(BPL ie1⓪(EXG.L D0,D1⓪$ie1 CMP.L D0,D1⓪(SGE D0⓪(ANDI #1,D0⓪ *)⓪$END⓪"END @SRGE;⓪ ⓪ PROCEDURE @SRLT; (* D1 < D0? -> D0 /D2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BPL ieee⓪ *)⓪ (*$? SoftReal:⓪(MOVE.B D0,D2⓪(OR.B D1,D2⓪(BMI.S onepos ; mindestens ein Operand positiv: normal⓪(EXG.L D0,D1 ; beide negativ: tauschen⓪!onepos CMP.B D0,D1⓪(BNE.S eval⓪(CMP.L D0,D1⓪#eval SCS D0⓪(ANDI.W #1,D0⓪(RTS⓪ *)⓪ (*$? IEEEReal:⓪#ieee TST.L D0⓪(BPL ie1⓪(TST.L D1⓪(BPL ie1⓪(EXG.L D0,D1⓪$ie1 CMP.L D0,D1⓪(SLT D0⓪(ANDI #1,D0⓪ *)⓪$END⓪"END @SRLT;⓪ ⓪ PROCEDURE @SRGT; (* D1 > D0? -> D0 /D2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BPL ieee⓪ *)⓪ (*$? SoftReal:⓪(MOVE.B D0,D2⓪(OR.B D1,D2⓪(BMI.S onepos ; mindestens ein Operand positiv: normal⓪(EXG.L D0,D1 ; beide negativ: tauschen⓪!onepos CMP.B D0,D1⓪(BNE.S eval⓪(CMP.L D0,D1⓪#eval SHI D0⓪(ANDI.W #1,D0⓪(RTS⓪ *)⓪ (*$? IEEEReal:⓪#ieee TST.L D0⓪(BPL ie1⓪(TST.L D1⓪(BPL ie1⓪(EXG.L D0,D1⓪$ie1 CMP.L D0,D1⓪(SGT D0⓪(ANDI #1,D0⓪ *)⓪$END⓪"END @SRGT;⓪ ⓪ PROCEDURE @SNEG; (* D0 -> D0 *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BPL ieee⓪ *)⓪ (*$? SoftReal:⓪(TST.L D0⓪(BEQ ZERO⓪(EORI.B #$80,D0⓪#zero RTS⓪ *)⓪ (*$? IEEEReal:⓪#ieee BCHG #31,D0⓪ *)⓪$END⓪"END @SNEG;⓪ ⓪ PROCEDURE @SABS; (* D0 -> D0 *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BPL ieee⓪ *)⓪ (*$? SoftReal:⓪(TST.L D0⓪(BEQ ZERO ; außer bei Null ...⓪(ORI.B #$80,D0 ; pos. Vorzeichenbit setzen⓪#zero RTS⓪ *)⓪ (*$? IEEEReal:⓪#ieee BCLR #31,D0⓪ *)⓪$END⓪"END @SABS;⓪ ⓪ PROCEDURE @SMUL; (* D1 * D0 -> D1, /D2,A0/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BMI soft⓪(BEQ externl⓪ *)⓪ (*$? M68881:⓪(FMOVE.S D1,FP0⓪(FSGLMUL.S D0,FP0⓪(FMOVE.S FP0,D1⓪(RTS⓪ *)⓪ (*$? A68881:⓪ externl MOVE.W #$4427,-(A7)⓪(JMP ShortDouble⓪ *)⓪ (*$? SoftReal:⓪ soft TST.L D1⓪(BEQ zero⓪(MOVE.L D0,D2 ; Exponenten holen, auch Nulltest⓪(BEQ zero⓪(⓪(MOVE.L D3,-(A7)⓪(⓪(; Vorzeichen des Ergebnisses in A0.B vorbereiten⓪(⓪(EOR.B D1,D2⓪(MOVEQ #$80,D3⓪(AND.B D3,D2⓪(EOR.B D3,D2 ; kippen wegen inv. Sign: Sign in D2⓪(MOVE D2,A0⓪(⓪(; vorläufigen Exponenten in D0.B vorbereiten⓪(⓪(MOVEQ #$7F,D3⓪(AND.B D3,D1 ; Vorzeichen weg⓪(AND.B D3,D0⓪(ADD.B D1,D0 ; Exponenten addieren⓪(SUB.B #$40,D0 ; einen Bias abziehen: vorl. Exponent in D0⓪(BCS zero2 ; Underflow⓪=; Overflow erst später abfragen; kann durch⓪=; Normalisieren des Ergebnisses verschwinden⓪(⓪(MOVE.L D1,D3 ; Argument 1⓪(SWAP D3 ; high Bytes⓪(MOVE.L D0,D2 ; Argument 0⓪(CLR.B D2⓪(MULU D3,D2 ; 1H * 0L in D2⓪(SWAP D0⓪(MULU D0,D3 ; 0H * 1H in D3⓪(CLR.B D1⓪(MULU D0,D1 ; 0H * 1L in D1⓪(SWAP D0 ; Exponent wieder im LowByte⓪(ADD.L D2,D1 ; niederwertige Teilprodukte addieren⓪(CLR.W D1 ; die unteren Bits weg⓪(ADDX.B D1,D1 ; aber den Carry der Addition mitnehmen⓪(SWAP D1 ; richtige Wertigkeit⓪(ADD.L D3,D1 ; Höherwertiges Teilprodukt dazu⓪(BPL normali⓪(ADD.L #$80,D1 ; aufrunden⓪(BCC setexp⓪(BRA roundov⓪ normali SUBQ.B #1,D0 ; Exponent dekrementieren⓪(BCS zero2 ; underflow⓪(ADD.L #$40,D1 ; Rundungsbit⓪(ADD.L D1,D1⓪(BCC setexp ; alles klar⓪ roundov ROXR.L #1,D1 ; Überlauf wegen zus. Rundung⓪(ADDQ.B #1,D0 ; alles zurück...⓪!setexp MOVE.B D0,D1 ; Exponent übernehmen⓪(BMI ovfl⓪(⓪(MOVE A0,D2⓪(OR.B D2,D1⓪(MOVE.L (A7)+,D3⓪(RTS⓪ ⓪#ovfl MOVE.L (A7)+,D3⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -7-$4000 ;overflow⓪(UNLK A5⓪(MOVEQ #0,D1⓪(RTS⓪ ⓪"zero2 MOVE.L (A7)+,D3⓪#zero MOVEQ #0,D1⓪ *)⓪$END⓪"END @SMUL;⓪ ⓪ PROCEDURE @SDIV; (* D1 / D0 -> D1, /D2,A0/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BMI soft⓪(BEQ externl⓪ *)⓪ (*$? M68881:⓪(FMOVE.S D1,FP0⓪(FSGLDIV.S D0,FP0⓪(FMOVE.S FP0,D1⓪(RTS⓪ *)⓪ (*$? A68881:⓪ externl MOVE.W #$4424,-(A7)⓪(JMP ShortDouble⓪ *)⓪ (*$? SoftReal:⓪ soft TST.L D0 ; Divisor⓪(BEQ DivBy0⓪(⓪(; Vorzeichen bestimmen⓪(⓪(MOVE.L D1,D2 ; Exponenten holen⓪(BEQ zero1⓪(MOVE.L D3,-(A7) ; zwischendurch mal die Regs retten⓪(MOVE.L D4,-(A7)⓪(EOR.B D0,D2⓪(MOVEQ #$80,D3 ;... und weiter mit der Vorzeichen-Bestimmung⓪(AND.B D3,D2⓪(EOR.B D3,D2 ; kippen wegen inv. Sign: Sign in D2⓪(MOVE D2,A0 ; D2 freimachen⓪(⓪(; Exponenten berechnen⓪(⓪(MOVEQ #$7F,D3⓪(AND.B D3,D0⓪(AND.B D1,D3⓪(SUB.B D0,D3 ; Exponenten subtrahieren⓪(ADD.B #$40,D3 ; einen Bias addieren: vorl. Exponent in D3⓪(BVS ovfl ; Overflow⓪=; Underflow erst später abfragen; kann durch⓪=; Normalisieren des Ergebnisses verschwinden⓪=⓪(; Mantissen vorbereiten für 16 bit-Division⓪(⓪(CLR.B D0⓪(CLR.B D1⓪(SWAP D0⓪(SWAP D1⓪(CMP.W D0,D1 ; wird Ergebnis >= 1 ?⓪(BCS less1⓪(ADDQ.B #1,D3 ; würde Überlauf bei DIVU geben: vorher korrig.⓪(BVS ovfl⓪(ROR.L #1,D1⓪(⓪(; erste Schätzung: D1.24 bit durch D0.16 bit⓪(⓪"less1 SWAP D1 ; Dividend restaurieren⓪(MOVE.L D1,D2 ; Kopie des Dividenden⓪(DIVU D0,D2 ; ... durch 16 bit Divisor teilen⓪(MOVE.W D2,D4 ; vorl. Ergebnis retten⓪(⓪(; vorl. Ergebnis * D0.24 bit, um den Fehler zu sehen⓪(⓪(MULU D0,D2 ; D0.high * Testergebnis⓪(SUB.L D2,D1 ; das schon mal vom Dividenden abziehen⓪(SWAP D0 ; Divisor jetzt restauriert⓪(SWAP D1⓪(MOVE.W D0,D2 ; D0.low⓪(CLR.B D2⓪(MULU D4,D2 ; * Testergebnis⓪(SUB.L D2,D1 ;⓪(BCC estok ; Schätzung war korrekt; bleibt noch ein Rest⓪(⓪(; Schätzung zu groß: Ergebnis korrigieren,⓪(; zum Rest einen Divisor wieder aufaddieren⓪(⓪(SUBQ.W #1,D4 ; vorl. Ergebnis korrigiert⓪(ADD.L D0,D1 ; Rest um Divisor erhöhen⓪(⓪(; Rest durch 16 bit Divisor teilen⓪(⓪"estok SWAP D0 ; 16 high Bits des Divisors⓪(CLR.W D1⓪(DIVU D0,D1⓪(⓪(; Ergebnis zusammenbauen und ggf. normalisieren⓪(⓪(SWAP D4⓪(BMI isnorm⓪(MOVE.W D1,D4 ; nicht normalisiert: selten!⓪(ADD.L D4,D4⓪(SUBQ.B #1,D3⓪(MOVE.W D4,D1 ; türken für folgenden Befehl⓪!isnorm MOVE.W D1,D4⓪(ADD.L #$80,D4⓪(MOVE.B D3,D4⓪(BMI zero2⓪(MOVE A0,D2⓪(EOR.B D2,D4⓪(MOVE.L D4,D1⓪(MOVE.L (A7)+,D4⓪(MOVE.L (A7)+,D3⓪"zero1 RTS⓪ ⓪!DivBy0 LINK A5,#0⓪(TRAP #6⓪(DC.W -5-$4000⓪(UNLK A5⓪ ⓪#zero MOVEQ #0,D1⓪(RTS⓪"⓪"zero2 MOVE.L (A7)+,D4⓪(MOVE.L (A7)+,D3⓪(BRA zero⓪ ⓪#Ovfl MOVE.L (A7)+,D4⓪(MOVE.L (A7)+,D3⓪(⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -7-$4000 ;overflow⓪(UNLK A5⓪(⓪(MOVEQ #0,D1⓪ *)⓪$END⓪"END @SDIV;⓪ ⓪ (*$? SoftReal:⓪ PROCEDURE MYSADD; (* Nur für Soft-ShortReals *)⓪"BEGIN⓪%ASSEMBLER⓪(; stelle |D0| >= |D1| sicher⓪(⓪(MOVE.L D0,D2 ; Vorzeichen retten⓪(BEQ Retn1 ; zweiter Summand ist Null⓪(⓪(MOVE.L D3,-(A7)⓪(⓪(MOVE.L D1,D3⓪(BEQ Retn2 ; erster Summand ist Null⓪(⓪(MOVE.L D4,-(A7)⓪(⓪(MOVEQ #$7F,D4⓪(AND.B D4,D0 ; Vorzeichen wegmaskieren⓪(AND.B D4,D1⓪(CMP.B D1,D0⓪(BHI passt ; klar größer⓪(BNE change ; klar kleiner⓪(CMP.L D1,D0 ; Mantissen vergleichen⓪(BCC passt ; größer oder gleich⓪!change EXG D0,D1⓪(EXG D2,D3⓪(⓪(; jetzt ist |D0| >= |D1|, und D2.B enthält das dominante Vorzeichen⓪(; Mantisse D1 stellenrichtig anpassen⓪(⓪"passt SUB.B D1,D0 ; Differenz der Exponenten⓪(BEQ shift0 ; gleich groß: nix zu tun⓪(CMPI.B #16,D0⓪(BCC shift16⓪(CLR.B D1⓪"small LSR.L D0,D1⓪(⓪(; Mantissen stehen; D2 enthält dominantes Sign/Exponent.⓪(; Jetzt addieren/subtrahieren.⓪(; Das gelöschte Sign Bit in D0 wirkt als Puffer⓪(; gegen Überläufe aus dem Low Byte.⓪(⓪!passt2 CLR.B D0⓪(EOR.B D2,D3 ; Vorzeichen gleich?⓪(BMI difsgn ; nein, subtrahieren⓪(ADD.L D1,D0 ; ja, addieren⓪(BCC ok⓪(ROXR.L #1,D0 ; Überlauf bei Addition: High Bit zurückholen⓪(ADDQ.B #1,D2 ; ... und Exponenten korrigieren⓪(BVS ovfl ; das kann Überlauf ergeben!⓪(BCC ok ; wg. Vorzeichenbit muß V+C geprüft werden⓪ ⓪#ovfl MOVE.L (A7)+,D4⓪(MOVE.L (A7)+,D3⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -7-$4000 ;overflow⓪(UNLK A5⓪(MOVEQ #0,D1⓪(RTS⓪ ⓪"Retn2 MOVE.L (A7)+,D3⓪(MOVE.L D0,D1⓪"Retn1 RTS⓪ ⓪!shift0 CLR.B D1⓪(BRA passt2⓪(⓪ shift16 CMPI.B #24,D0⓪(BHI ok ; vernachlässigen: gib D0,D2 zurück⓪(BEQ shift24 ; nur ein Rundungsbit zu berücksichtigen⓪(CLR.W D1 ; 16..23 Shifts: 16 Stück schnell⓪(SWAP D1⓪(SUBI.B #16,D0⓪(BRA small⓪(⓪ shift24 MOVE.L #$80,D1 ; kleines Argument: High Bit SHR 24⓪(BRA passt2⓪#⓪!difsgn SUB.L D1,D0 ; ungleiche Vorzeichen: subtrahieren⓪(BMI ok ; Mantisse ist normalisiert⓪(MOVE.B D2,D3 ; Vorzeichen retten für Underflow Check⓪(SUBQ.B #1,D2 ; DBMI-Korrektur (s.u.)⓪(CLR.B D0 ; erstmal die ungültigen Low-Bits weg⓪(CMPI.L #$7FFF,D0 ; mehr als 16 Shifts nötig?⓪(BHI small1⓪(TST.W D0⓪(BEQ zero⓪(SWAP D0⓪(SUBI.B #16,D2⓪!small1 ADD.L D0,D0 ; Shift 1 Bit⓪(DBMI D2,small1⓪(EOR.B D2,D3⓪(BMI zero ; Vorzeichen gekippt: Exponent Underflow⓪(⓪%ok MOVE.B D2,D0 ; Exponent des größeren Arguments restaurieren⓪(MOVE.L (A7)+,D4⓪(MOVE.L (A7)+,D3⓪(MOVE.L D0,D1⓪(RTS⓪ ⓪#zero MOVE.L (A7)+,D4⓪(MOVE.L (A7)+,D3⓪(MOVEQ #0,D1⓪$END⓪"END MYSADD;⓪ *)⓪ ⓪ PROCEDURE @SADD; (* D1 + D0 -> D1, /D2/ *)⓪"BEGIN⓪%ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BMI soft⓪(BEQ externl⓪ *)⓪ (*$? M68881:⓪(FMOVE.S D1,FP0⓪(FADD.S D0,FP0⓪(FMOVE.S FP0,D1⓪(RTS⓪ *)⓪ (*$? A68881:⓪ externl MOVE.W #$4422,-(A7)⓪(JMP ShortDouble⓪ *)⓪ (*$? SoftReal:⓪ soft JMP MYSADD⓪ *)⓪$END⓪"END @SADD;⓪ ⓪ PROCEDURE @SSUB; (* D1 - D0 -> D1, /D2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BMI soft⓪(BEQ externl⓪ *)⓪ (*$? M68881:⓪(FMOVE.S D1,FP0⓪(FSUB.S D0,FP0⓪(FMOVE.S FP0,D1⓪(RTS⓪ *)⓪ (*$? A68881:⓪ extern MOVE.W #$4428,-(A7)⓪(JMP ShortDouble⓪ *)⓪ (*$? SoftReal:⓪ soft TST.L D0⓪(BEQ ZERO⓪(EORI.B #$80,D0 ; kippe Vorzeichen des zweiten Arguments⓪(JMP MYSADD⓪#zero ; zweites Argument Null: das ist einfach⓪ *)⓪$END⓪"END @SSUB;⓪ ⓪ (*⓪!* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~⓪!*⓪!* S T - F P U⓪!* _____________⓪!* Erkenntnisse:⓪!*⓪!* Wird eine Operation ausgeführt, die zu einem Fehler führt, z.B.⓪!* DivBy0, Operand Error, Overflow, dann wird die Exeption nicht sofort⓪!* nach dem Empfang von Befehl und Argument angezeigt, sondern erst beim⓪!* Senden des nächsten Befehls.⓪!* Das heißt: 1. Die Exc geht nicht verloren, wenn man vor der Abfrage den⓪!* neuen Befehl übergibt. 2. Dort, wo sicher ist, daß ein Dialog beendet⓪!* ist, also das CA-Bit gelöscht ist, braucht auch kein Exception-Check⓪!* mehr gemacht werden - nach der Übergabe des 1. Commands muß jedoch⓪!* immer eine Exc. geprüft werden.⓪!*⓪!* Durch das Lesen des Statusregs werden CPU und FPU synchronisiert! Das⓪!* heißt: Die FPU läßt ggf. die CPU warten, bis die FPU ihre Zyklen⓪!* abgearbeitet hat. Dadurch ist auch eine Funktionsfähigkeit bei sehr⓪!* schneller CPU gewährleistet, allerdings nur bei der 68881 (bei 68882⓪!* darf CPU nur 1.5 mal schneller sein).⓪!* Allerdings darf man nicht überall damit rechnen, daß eine genau⓪!* abzählbare Anzahl von Status-Reads erforderlich ist. So scheint das⓪!* zwar zu funktionieren, wenn Daten zw. CPU und FPU übertragen werden⓪!* (dann braucht nur jew. ein Lesezugriff zw. den Transfers erfolgen),⓪!* jedoch z.B. nicht, wenn ein FMOVE FPn,<ea> abgesetzt wurde: hier muß⓪!* dann auf den Übertragungsbefehl in einer Schleife gewartet werden!⓪!*)⓪ ⓪ PROCEDURE @FNUL; (* F-Instr. in D0 *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D0,cpGEN1⓪(JMP cpGEN0⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx FPn⓪(MOVE.W D0,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(SUBQ.B #2,D0⓪(BHI error⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪ *)⓪$END⓪"END @FNUL;⓪ ⓪ PROCEDURE @FCPN; (* F-Instr. in D0, Cond. in D2 *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D0,cpGEN1⓪(MOVE D2,cpScc1⓪(JSR cpGEN0⓪(JSR cpScc0⓪(ANDI #1,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx FPn⓪(MOVE.W D0,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(SUBQ.B #2,D0⓪(BHI error⓪(MOVE.W D2,A2cond(A2) ;FBcc⓪(MOVE.W (A2),D0 ;Bool-Wert abholen⓪(ANDI #1,D0⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(MOVEQ #0,D0⓪ *)⓪$END⓪"END @FCPN;⓪ ⓪ PROCEDURE @FOPS; (* F-Instr. in D0, <ea>.S in D1 *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D0,cpGENS1⓪(JMP cpGENS0⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx.S D1,FPn⓪(MOVE.W D0,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(SUBQ.B #4,D0⓪(BNE error⓪(MOVE.L D1,A2op(A2)⓪(TST.W (A2)⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪ *)⓪$END⓪"END @FOPS;⓪ ⓪ PROCEDURE @FCPS; (* F-Instr. in D0, Cond. in D2, <ea>.S in D1 *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D0,cpGENS1⓪(MOVE D2,cpScc1⓪(JSR cpGENS0⓪(JSR cpScc0⓪(ANDI #1,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(JSR @FOPS⓪(MOVE.W D2,A2cond(A2) ;FBcc⓪(MOVE.W (A2),D0 ;Bool-Wert abholen⓪(ANDI #1,D0⓪ *)⓪$END⓪"END @FCPS;⓪ ⓪ PROCEDURE @FOPD; (* F-Instr. in D0, <ea>.D in (A0) /A2/ *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D0,cpGENL1⓪(JMP cpGENL0⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx.D (A0),FPn⓪(MOVE.W D0,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(SUBQ.B #8,D0⓪(BNE error⓪(MOVE.L (A0)+,A2op(A2)⓪(TST.W (A2)⓪(MOVE.L (A0),A2op(A2)⓪(TST.W (A2)⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪ *)⓪$END⓪"END @FOPD;⓪ ⓪ PROCEDURE @FCPD; (* F-Instr. in D0, Cond. in D2, <ea>.D in (A0) *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D0,cpGENL1⓪(MOVE D2,cpScc1⓪(JSR cpGENL0⓪(JSR cpScc0⓪(ANDI #1,D0⓪(RTS⓪ *)⓪ (*$? A68881:⓪ external⓪(JSR @FOPD⓪(MOVE.W D2,A2cond(A2) ;FBcc⓪(MOVE.W (A2),D0 ;Bool-Wert abholen⓪(ANDI #1,D0⓪ *)⓪$END⓪"END @FCPD;⓪ ⓪ PROCEDURE @FMVS; (* F-Instr. in D0, <ea>.S nach (A0) *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D0,cpGENL1⓪(JMP cpGENL0⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx.S FPn,(A0)⓪(MOVE.W D0,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(SUBQ.B #4,D0⓪(BNE error⓪(MOVE.L A2op(A2),(A0)⓪(CMPI.W #$0802,(A2)⓪(BNE error⓪(RTS⓪ error CLR.L (A0)⓪(LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪ *)⓪$END⓪"END @FMVS;⓪ ⓪ PROCEDURE @FMVD; (* F-Instr. in D0, <ea>.D nach (A0) *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D0,cpGENL1⓪(JMP cpGENL0⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx.D FPn,(A0)⓪(MOVE.W D0,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(SUBQ.B #8,D0⓪(BNE error⓪(MOVE.L A2op(A2),(A0)+⓪(TST.W (A2)⓪(MOVE.L A2op(A2),(A0)⓪(CMPI.W #$0802,(A2)⓪(BNE error2⓪(RTS⓪ error CLR.L (A0)+⓪(CLR.L (A0)⓪ error2 LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪ *)⓪$END⓪"END @FMVD;⓪ ⓪ ⓪ PROCEDURE @FP7S; (* Push FPn auf A7. Opcode in D2 ("FMOVE.S FPn,ea") *)⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L (A7),-(A7)⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D2,cpPsh71⓪(JMP cpPsh70⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx.S FPn,4(A7)⓪(MOVE.W D2,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D2⓪(TST.B D2⓪(BEQ DoDl1⓪(SUBQ.B #4,D2⓪(BNE error⓪(MOVE.L A2op(A2),4(A7)⓪(CMPI.W #$0802,(A2)⓪(BNE error⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L 4(A7)⓪ *)⓪$END⓪"END @FP7S;⓪ ⓪ PROCEDURE @FP7D; (* Push FPn auf A7. Opcode in D2 ("FMOVE.D FPn,ea") *)⓪"BEGIN⓪$ASSEMBLER⓪(SUBQ.L #8,A7⓪(MOVE.L 8(A7),(A7)⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D2,cpPsh71⓪(JMP cpPsh70⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx.D FPn,4(A7)⓪(MOVE.W D2,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D2⓪(TST.B D2⓪(BEQ DoDl1⓪(SUBQ.B #8,D2⓪(BNE error⓪(MOVE.L A2op(A2),4(A7)⓪(TST.W (A2)⓪(MOVE.L A2op(A2),8(A7)⓪(CMPI.W #$0802,(A2)⓪(BNE error⓪(RTS⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L 4(A7)⓪(CLR.L 8(A7)⓪ *)⓪$END⓪"END @FP7D;⓪ ⓪ ⓪ PROCEDURE @FP3S; (* Push FPn auf A3. Opcode in D2 ("FMOVE.S FPn,ea") *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D2,cpPsh31⓪(JMP cpPsh30⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx.S FPn,(A3)+⓪(MOVE.W D2,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D2⓪(TST.B D2⓪(BEQ DoDl1⓪(SUBQ.B #4,D2⓪(BNE error⓪(MOVE.L A2op(A2),(A3)+⓪(CMPI.W #$0802,(A2)⓪(BNE error2⓪(RTS⓪ error2 SUBQ.L #4,A3⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L (A3)+⓪ *)⓪$END⓪"END @FP3S;⓪ ⓪ PROCEDURE @FP3D; (* Push FPn auf A7. Opcode in D2 ("FMOVE.D FPn,ea") *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(MOVE D2,cpPsh31⓪(JMP cpPsh30⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; Fxxxx.D FPn,(A3)+⓪(MOVE.W D2,A2cmd(A2)⓪ DoDl1 MOVE.W (A2),D2⓪(TST.B D2⓪(BEQ DoDl1⓪(SUBQ.B #8,D2⓪(BNE error⓪(MOVE.L A2op(A2),(A3)+⓪(TST.W (A2)⓪(MOVE.L A2op(A2),(A3)+⓪(CMPI.W #$0802,(A2)⓪(BNE error2⓪(RTS⓪ error2 SUBQ.L #8,A3⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪(CLR.L (A3)+⓪(CLR.L (A3)+⓪ *)⓪$END⓪"END @FP3D;⓪ ⓪ ⓪ PROCEDURE @FP7M; (* FMOVEM: Push FP-list auf A7. Opcode in D0, A1/A2 benutzt *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -24-$6000 ; ConfigErr: caller caused, no cont⓪(UNLK A5⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; FMOVEM.X <static list>,-(A7)⓪(MOVE.W D0,A2cmd(A2)⓪(TST.W (A2)⓪ DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(CMPI.B #$0C,D0⓪(BNE error⓪(MOVE.L (A7)+,D0 ; save return-address⓪(TST.W A2regsel(A2)⓪(MOVEA.W #$FA50,A1⓪ again SUBQ.L #8,A7⓪(MOVE.L (A1),-(A7)⓪(TST.W (A2)⓪(MOVE.L (A1),4(A7)⓪(TST.W (A2)⓪(MOVE.L (A1),8(A7)⓪(CMPI.W #$0802,(A2)⓪(BNE again⓪(MOVE.L D0,A2⓪(JMP (A2)⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪ *)⓪$END⓪"END @FP7M;⓪ ⓪ PROCEDURE @FG7M; (* FMOVEM: Load FP-list von A7. Opcode in D0, A1/A2 benutzt *)⓪"BEGIN⓪$ASSEMBLER⓪ (*$? AutoFPU:⓪(TST fpu⓪(BEQ external⓪ *)⓪ (*$? M68881:⓪(LINK A5,#0⓪(TRAP #6⓪(DC.W -24-$6000 ; ConfigErr: caller caused, no cont⓪(UNLK A5⓪ *)⓪ (*$? A68881:⓪ external⓪(MOVEA.W #$FA40,A2⓪(; FMOVEM.X (A7)+,<static list>⓪(MOVE.W D0,A2cmd(A2)⓪(TST.W (A2)⓪ DoDl1 MOVE.W (A2),D0⓪(TST.B D0⓪(BEQ DoDl1⓪(CMPI.B #$0C,D0⓪(BNE error⓪(MOVE.L (A7)+,D0 ; save return-address⓪(TST.W A2regsel(A2)⓪(MOVEA.W #$FA50,A1⓪ again MOVE.L (A7)+,(A1)⓪(TST.W (A2)⓪(MOVE.L (A7)+,(A1)⓪(TST.W (A2)⓪(MOVE.L (A7)+,(A1)⓪(CMPI.W #$0802,(A2)⓪(BNE again⓪(MOVE.L D0,A2⓪(JMP (A2)⓪ error LINK A5,#0⓪(JSR FPUError⓪(UNLK A5⓪ *)⓪$END⓪"END @FG7M;⓪ ⓪ PROCEDURE @FG7S; BEGIN HALT END @FG7S;⓪ PROCEDURE @FG7D; BEGIN HALT END @FG7D;⓪ PROCEDURE @FG3S; BEGIN HALT END @FG3S;⓪ PROCEDURE @FG3D; BEGIN HALT END @FG3D;⓪ ⓪ ⓪ PROCEDURE @VFPU;⓪"(*⓪"BEGIN⓪$ASSEMBLER⓪(; FPU-Benutzung initialisieren, damit bei TRANSFER⓪(; auch die FPU-Regs gesichert werden⓪(TST fpu⓪(BMI error⓪(⓪(; MOVE #1,SwitchFPUContext⓪(RTS⓪(⓪&error⓪(TRAP #6⓪(DC.W -24-$A000 ; Config-Error, text follows, no cont⓪(ACZ 'program needs FPU'⓪$END⓪"*)⓪"END @VFPU;⓪ ⓪ PROCEDURE @V020;⓪"(*⓪"BEGIN⓪$ASSEMBLER⓪(; Prüfen, ob 68020 vorhanden ist⓪(⓪(TST useSF⓪(BNE ok⓪(⓪(TRAP #6⓪(DC.W -24-$E000 ; Config-Error, text follows, caller, no cont⓪(ACZ 'program needs 68020'⓪(SYNC⓪&ok⓪$END⓪"*)⓪"END @V020;⓪ ⓪ ⓪ PROCEDURE @RES1;⓪"(* Vergleich für lok. Proc-Parms *)⓪"BEGIN⓪$ASSEMBLER⓪(CMPM.L (A0)+,(A1)+⓪(BNE ende⓪(CMPM.L (A0)+,(A1)+⓪&ende⓪$END⓪"END @RES1;⓪ ⓪ PROCEDURE @RES2; BEGIN HALT END @RES2;⓪ PROCEDURE @RES3; BEGIN HALT END @RES3;⓪ PROCEDURE @RES4; BEGIN HALT END @RES4;⓪ PROCEDURE @RES5; BEGIN HALT END @RES5;⓪ PROCEDURE @RES6; BEGIN HALT END @RES6;⓪ PROCEDURE @RES7; BEGIN HALT END @RES7;⓪ ⓪ ⓪ VAR remCarrier: RemovalCarrier;⓪ ⓪ BEGIN⓪"useSF:= SysInfo.UseStackFrame ();⓪"CoroutineTrapNo:= 4;⓪"(*$? AutoFpu:⓪$fpu:= INTEGER (SysInfo.FPU ()) - 1;⓪$(* SwitchFPUContext:= FALSE; *)⓪$IF fpu = 0 THEN⓪&FPUInit⓪$ELSIF fpu > 0 THEN⓪&(* interne FPU initialisieren: *)⓪&ASSEMBLER FMOVE #$0000F400,FPCR (* s.o.*) END;⓪&(* >> Autom. Exc bei Overflow, DivBy0, Operand Error,⓪,signalling NAN, Bcc/Scc on unordered *)⓪&CaughtExceptions:=⓪0CaughtExceptions +⓪0ExcSet {BSUnExc, FPZeroDivide, OpError, FPOverflow, NANExc};⓪$END;⓪"*)⓪"(*$? AutoFpu & SoftReal:⓪$!!! hier nochmal setzen?⓪$fpu:= -1;⓪"*)⓪"(*$? M68881:⓪$(*$? AutoFpu:⓪&!!! hier nochmal setzen?⓪&fpu:= 1;⓪$*)⓪$IF SysInfo.FPU () # SysInfo.internalFPU THEN⓪&ASSEMBLER⓪(MOVE.W #MOSGlobals.fUnknownDevice,(A3)+⓪(JMP Abort⓪&END⓪$END;⓪$ASSEMBLER FMOVE #$0000F400,FPCR (* s.o.*) END;⓪$CaughtExceptions:=⓪0CaughtExceptions +⓪0ExcSet {BSUnExc, FPZeroDivide, OpError, FPOverflow, NANExc};⓪$cpGEN2:= rtsCode;⓪$cpScc2:= rtsCode;⓪$cpGENS2:= rtsCode;⓪$cpGENL2:= rtsCode;⓪$cpPsh72:= 4;⓪$cpPsh73:= rtsCode;⓪$cpPsh32:= rtsCode;⓪$cpGEN0:= $F200;⓪$cpScc0:= $F240;⓪$cpGENL0:= $F210;⓪$cpGENS0:= $F201;⓪$cpPsh70:= $F22F;⓪$cpPsh30:= $F21B;⓪"*)⓪"(*$? A68881:⓪$(*$? AutoFpu:⓪&!!! hier nochmal setzen?⓪&fpu:= 0;⓪$*)⓪$FPUInit;⓪"*)⓪"CatchRemoval (remCarrier, LinkOut, MOSGlobals.MemArea {NIL,0});⓪ END Runtime.⓪ ə (* $0000DAA6$0001952B$0001951F$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$00001362$FFFB3F34$0001BEDD$FFFB3F34$00019E3C$FFFB3F34$FFFB3F34$FFFB3F34$00003CD3$FFFB3F34$000053CB$FFFB3F34$FFFB3F34$FFFB3F34$0000652C$FFFB3F34$FFFB3F34$FFEE513D$FFFB3F34$00002A93$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$00004D96$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34Ç$0000135FT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$0001A83C$0001AAA6$0001ACEE$0001ACCA$0001ACC2$FFE55FC0$0001AFCE$FFE55FC0$FFE55FC0$0001AFAA$0001AFE1$0001AFA7$0001B32C$0000135F$000012E4$0000135FÇÇé*)